From a658ffde26f24ce9f63cffa06f482dab60758373 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 27 Dec 2022 10:41:42 -0500
Subject: [PATCH 001/118] ADD useful print things

---
 bin/xmonad.hs | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index d84b8d6..7f3ab19 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -140,14 +140,22 @@ evalConf db@DBusState { dbSysClient = cl } = do
   let fs = features cl
   startDBusInterfaces fs
   (xmobarHandle, ts) <- startChildDaemons fs
+  io $ putStrLn "child daemons started"
   startRemovableMon fs
+  io $ putStrLn "removemon started"
   startPowerMon fs
+  io $ putStrLn "powermon started"
   dws <- startDynWorkspaces fs
+  io $ putStrLn "dyn workspace started"
   tt <- evalAlways $ fsTabbedTheme fs
+  io $ putStrLn "tabbed theme started"
   -- fb <- evalAlways $ fsFontBuilder features
   kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
+  io $ putStrLn "keys started"
   sk <- evalAlways $ fsShowKeys fs
+  io $ putStrLn "showkeys started"
   ha <- evalAlways $ fsACPIHandler fs
+  io $ putStrLn "acpi handler started"
   return $ ewmh
     $ addKeymap dws sk kbs
     $ docks

From 5adc88cd099799b56cf2b790a41f3fc85bf0d5ea Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 27 Dec 2022 10:45:12 -0500
Subject: [PATCH 002/118] ADD more logging

---
 bin/xmonad.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 7f3ab19..be475d1 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -138,7 +138,9 @@ evalConf db@DBusState { dbSysClient = cl } = do
   -- start DBus interfaces first since many features after this test these
   -- interfaces as dependencies
   let fs = features cl
+  io $ putStrLn "hi"
   startDBusInterfaces fs
+  io $ putStrLn "dbus started"
   (xmobarHandle, ts) <- startChildDaemons fs
   io $ putStrLn "child daemons started"
   startRemovableMon fs

From 04f32d12e7ff749f407d14642c4c987fa46597bd Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 27 Dec 2022 10:48:35 -0500
Subject: [PATCH 003/118] ADD lots of flushes

---
 bin/xmonad.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index be475d1..28c7dcb 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -139,25 +139,35 @@ evalConf db@DBusState { dbSysClient = cl } = do
   -- interfaces as dependencies
   let fs = features cl
   io $ putStrLn "hi"
+  io $ hFlush stdout
   startDBusInterfaces fs
   io $ putStrLn "dbus started"
+  io $ hFlush stdout
   (xmobarHandle, ts) <- startChildDaemons fs
   io $ putStrLn "child daemons started"
+  io $ hFlush stdout
   startRemovableMon fs
   io $ putStrLn "removemon started"
+  io $ hFlush stdout
   startPowerMon fs
   io $ putStrLn "powermon started"
+  io $ hFlush stdout
   dws <- startDynWorkspaces fs
   io $ putStrLn "dyn workspace started"
+  io $ hFlush stdout
   tt <- evalAlways $ fsTabbedTheme fs
   io $ putStrLn "tabbed theme started"
+  io $ hFlush stdout
   -- fb <- evalAlways $ fsFontBuilder features
   kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
   io $ putStrLn "keys started"
+  io $ hFlush stdout
   sk <- evalAlways $ fsShowKeys fs
   io $ putStrLn "showkeys started"
+  io $ hFlush stdout
   ha <- evalAlways $ fsACPIHandler fs
   io $ putStrLn "acpi handler started"
+  io $ hFlush stdout
   return $ ewmh
     $ addKeymap dws sk kbs
     $ docks

From 504c719bdddb61c79b3607d950c64ed7ca753b50 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 27 Dec 2022 10:54:51 -0500
Subject: [PATCH 004/118] ENH change order

---
 bin/xmonad.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 28c7dcb..11bdfa7 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -137,9 +137,12 @@ features cl = FeatureSet
 evalConf db@DBusState { dbSysClient = cl } = do
   -- start DBus interfaces first since many features after this test these
   -- interfaces as dependencies
-  let fs = features cl
   io $ putStrLn "hi"
   io $ hFlush stdout
+  let fs = features cl
+  tt <- evalAlways $ fsTabbedTheme fs
+  io $ putStrLn "tabbed theme started"
+  io $ hFlush stdout
   startDBusInterfaces fs
   io $ putStrLn "dbus started"
   io $ hFlush stdout
@@ -155,9 +158,6 @@ evalConf db@DBusState { dbSysClient = cl } = do
   dws <- startDynWorkspaces fs
   io $ putStrLn "dyn workspace started"
   io $ hFlush stdout
-  tt <- evalAlways $ fsTabbedTheme fs
-  io $ putStrLn "tabbed theme started"
-  io $ hFlush stdout
   -- fb <- evalAlways $ fsFontBuilder features
   kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
   io $ putStrLn "keys started"

From 761653265d0291d31164eb43645e42f28337968b Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 27 Dec 2022 12:02:07 -0500
Subject: [PATCH 005/118] ENH add test

---
 bin/xmonad.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 11bdfa7..7b4dd74 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -143,6 +143,8 @@ evalConf db@DBusState { dbSysClient = cl } = do
   tt <- evalAlways $ fsTabbedTheme fs
   io $ putStrLn "tabbed theme started"
   io $ hFlush stdout
+  -- uninstallSignalHandlers
+  -- io $ print =<< readCreateProcessWithExitCode (proc "echo" ["hi"]) ""
   startDBusInterfaces fs
   io $ putStrLn "dbus started"
   io $ hFlush stdout

From b058d1245e26d0c238d5af6da384988037308918 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 27 Dec 2022 14:13:13 -0500
Subject: [PATCH 006/118] ENH don't mess with signal handlers during setup

---
 bin/xmobar.hs                          | 10 ++----
 bin/xmonad.hs                          | 48 ++++++++++++++++++--------
 lib/Data/Internal/Dependency.hs        |  2 +-
 lib/XMonad/Internal/Command/Desktop.hs |  3 +-
 lib/XMonad/Internal/Command/Power.hs   |  7 ++--
 5 files changed, 43 insertions(+), 27 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 3cd0e36..1afbe6d 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -34,7 +34,6 @@ import           Xmobar.Plugins.IntelBacklight
 import           Xmobar.Plugins.Screensaver
 import           Xmobar.Plugins.VPN
 
-import           System.Posix.Signals
 import           XMonad.Core                                    hiding (config)
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.Command.Power
@@ -65,9 +64,6 @@ run = do
   db <- connectDBus
   c <- withCache $ evalConfig db
   disconnectDBus db
-  -- this is needed to prevent waitForProcess error when forking in plugins (eg
-  -- alsacmd)
-  _ <- installHandler sigCHLD Default Nothing
   -- this is needed to see any printed messages
   hFlush stdout
   xmobar c
@@ -422,16 +418,16 @@ dateCmd = CmdSpec
 
 vpnPresent :: IO (Maybe Msg)
 vpnPresent =
-  go <$> tryIOError (readCreateProcessWithExitCode' (proc' "nmcli" args) "")
+  go <$> tryIOError (readCreateProcessWithExitCode (proc "nmcli" args) "")
   where
     args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
-    go (Right (ExitSuccess, out, _))   = if "vpn" `elem` T.lines out then Nothing
+    go (Right (ExitSuccess, out, _))   = if "vpn" `elem` lines out then Nothing
                                          else Just $ Msg LevelError "vpn not found"
     go (Right (ExitFailure c, _, err)) = Just $ Msg LevelError
                                          $ T.concat ["vpn search exited with code "
                                                     , T.pack $ show c
                                                     , ": "
-                                                    , err]
+                                                    , T.pack err]
     go (Left e)                        = Just $ Msg LevelError $ T.pack $ show e
 
 --------------------------------------------------------------------------------
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 7b4dd74..55a160e 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -82,11 +82,24 @@ parse _          = usage
 
 run :: IO ()
 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
+  -- required to see stdout) and will also install xmonad's silly signal
+  -- handlers (which set the handlers for sigCHLD and sigPIPE to SIG_IGN).
+  -- Ignoring sigCHLD is particularly bad since most of my setup entails
+  -- spawning processes and waiting for their exit code, which totally breaks
+  -- when sigCHLD is ignored (since children are killed immediately without
+  -- the parent invoking 'wait'). Since the 'launch' function is called last
+  -- here, everything before should be fine except for the case where xmonad
+  -- is restarted, which uses 'exec' and thus should cause the buffering and
+  -- signal handlers to carry over to the top.
+  uninstallSignalHandlers
+  hSetBuffering stdout LineBuffering
   db <- connectDBusX
   conf <- withCache $ evalConf db
   ds <- getCreateDirectories
   -- IDK why this is necessary; nothing prior to this will print if missing
-  hFlush stdout
+  -- hFlush stdout
   launch conf ds
 
 getCreateDirectories :: IO Directories
@@ -138,38 +151,37 @@ evalConf db@DBusState { dbSysClient = cl } = do
   -- start DBus interfaces first since many features after this test these
   -- interfaces as dependencies
   io $ putStrLn "hi"
-  io $ hFlush stdout
+  -- io $ hFlush stdout
   let fs = features cl
   tt <- evalAlways $ fsTabbedTheme fs
   io $ putStrLn "tabbed theme started"
-  io $ hFlush stdout
-  -- uninstallSignalHandlers
+  -- io $ hFlush stdout
   -- io $ print =<< readCreateProcessWithExitCode (proc "echo" ["hi"]) ""
   startDBusInterfaces fs
   io $ putStrLn "dbus started"
-  io $ hFlush stdout
+  -- io $ hFlush stdout
   (xmobarHandle, ts) <- startChildDaemons fs
   io $ putStrLn "child daemons started"
-  io $ hFlush stdout
+  -- io $ hFlush stdout
   startRemovableMon fs
   io $ putStrLn "removemon started"
-  io $ hFlush stdout
+  -- io $ hFlush stdout
   startPowerMon fs
   io $ putStrLn "powermon started"
-  io $ hFlush stdout
+  -- io $ hFlush stdout
   dws <- startDynWorkspaces fs
   io $ putStrLn "dyn workspace started"
-  io $ hFlush stdout
+  -- io $ hFlush stdout
   -- fb <- evalAlways $ fsFontBuilder features
   kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
   io $ putStrLn "keys started"
-  io $ hFlush stdout
+  -- io $ hFlush stdout
   sk <- evalAlways $ fsShowKeys fs
   io $ putStrLn "showkeys started"
-  io $ hFlush stdout
+  -- io $ hFlush stdout
   ha <- evalAlways $ fsACPIHandler fs
   io $ putStrLn "acpi handler started"
-  io $ hFlush stdout
+  -- io $ hFlush stdout
   return $ ewmh
     $ addKeymap dws sk kbs
     $ docks
@@ -180,7 +192,7 @@ evalConf db@DBusState { dbSysClient = cl } = do
           , handleEventHook = myEventHook ha
           , startupHook = myStartupHook
           , workspaces = myWorkspaces
-          , logHook = myLoghook xmobarHandle
+          , logHook = maybe logViewports myLoghook xmobarHandle
           , clickJustFocuses = False
           , focusFollowsMouse = False
           , normalBorderColor = T.unpack XT.bordersColor
@@ -191,9 +203,15 @@ evalConf db@DBusState { dbSysClient = cl } = do
     startDBusInterfaces fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
       $ fsDBusExporters fs
     startChildDaemons fs = do
-      (h, p) <- io $ spawnPipe "xmobar"
+      -- (h, p) <- io $ spawnPipe "xmobar"
+      (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe }
+      io $ case h of
+        Just h' -> hSetBuffering h' LineBuffering
+        Nothing -> return ()
+      --installSignalHandlers
       ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
-      return (h, ThreadState (p:ps) [h])
+      -- uninstallSignalHandlers
+      return (h, ThreadState (p:ps) $ maybeToList h)
     startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
                         $ dbSysClient db
     startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index 2e3f0a8..9b7b563 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -681,7 +681,7 @@ testSysDependency (AccessiblePath p r w) = permMsg <$> getPermissionsSafe p
 
 shellTest :: T.Text -> T.Text -> IO (Maybe Msg)
 shellTest cmd msg = do
-  (rc, _, _) <- readCreateProcessWithExitCode' (shell $ T.unpack cmd) ""
+  (rc, _, _) <- readCreateProcessWithExitCode (shell $ T.unpack cmd) ""
   return $ case rc of
     ExitSuccess -> Nothing
     _           -> Just $ Msg LevelError msg
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index babeb5b..ebd16bc 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -257,7 +257,8 @@ runNetAppDaemon cl = Sometimes "network applet" xpfVPN
   where
     tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
     app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
-    cmd _ = snd <$> spawnPipe "nm-applet"
+    -- cmd _ = snd <$> spawnPipe "nm-applet"
+    cmd _ = spawnProcess "nm-applet" []
 
 runToggleBluetooth :: Maybe SysClient -> SometimesX
 runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index b179cc9..3cb9128 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -42,10 +42,10 @@ import qualified RIO.Text                    as T
 import           System.Directory
 import           System.Exit
 import           System.IO.Error
-import           System.Process              (ProcessHandle)
+import           System.Process              (ProcessHandle, spawnProcess)
 
 import           XMonad.Core
-import           XMonad.Internal.Process     (spawnPipeArgs)
+-- import           XMonad.Internal.Process     (spawnPipeArgs)
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme       as XT
 import           XMonad.Prompt
@@ -96,7 +96,8 @@ runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
   where
     tree = And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock")
       $ Only_ $ IOSometimes_ runScreenLock
-    cmd = snd <$> spawnPipeArgs "xss-lock" ["--ignore-sleep", "screenlock"]
+    -- cmd = snd <$> spawnPipeArgs "xss-lock" ["--ignore-sleep", "screenlock"]
+    cmd = spawnProcess "xss-lock" ["--ignore-sleep", "screenlock"]
 
 --------------------------------------------------------------------------------
 -- | Confirmation prompts

From 23956e063b42e4d6d020b6d9d661eba5a703da5f Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 27 Dec 2022 14:18:56 -0500
Subject: [PATCH 007/118] REF get rid of dead code

---
 bin/xmonad.hs                          |  1 -
 lib/XMonad/Internal/Command/Desktop.hs |  1 -
 lib/XMonad/Internal/Command/Power.hs   |  2 --
 lib/XMonad/Internal/Process.hs         | 26 +++++++++++++-------------
 4 files changed, 13 insertions(+), 17 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 55a160e..f01daaa 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -203,7 +203,6 @@ evalConf db@DBusState { dbSysClient = cl } = do
     startDBusInterfaces fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
       $ fsDBusExporters fs
     startChildDaemons fs = do
-      -- (h, p) <- io $ spawnPipe "xmobar"
       (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe }
       io $ case h of
         Just h' -> hSetBuffering h' LineBuffering
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index ebd16bc..b5270a0 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -257,7 +257,6 @@ runNetAppDaemon cl = Sometimes "network applet" xpfVPN
   where
     tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
     app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
-    -- cmd _ = snd <$> spawnPipe "nm-applet"
     cmd _ = spawnProcess "nm-applet" []
 
 runToggleBluetooth :: Maybe SysClient -> SometimesX
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index 3cb9128..df4b86a 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -45,7 +45,6 @@ import           System.IO.Error
 import           System.Process              (ProcessHandle, spawnProcess)
 
 import           XMonad.Core
--- import           XMonad.Internal.Process     (spawnPipeArgs)
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme       as XT
 import           XMonad.Prompt
@@ -96,7 +95,6 @@ runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
   where
     tree = And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock")
       $ Only_ $ IOSometimes_ runScreenLock
-    -- cmd = snd <$> spawnPipeArgs "xss-lock" ["--ignore-sleep", "screenlock"]
     cmd = spawnProcess "xss-lock" ["--ignore-sleep", "screenlock"]
 
 --------------------------------------------------------------------------------
diff --git a/lib/XMonad/Internal/Process.hs b/lib/XMonad/Internal/Process.hs
index 9d92e8b..79f3d21 100644
--- a/lib/XMonad/Internal/Process.hs
+++ b/lib/XMonad/Internal/Process.hs
@@ -4,9 +4,9 @@
 module XMonad.Internal.Process
   ( waitUntilExit
   , killHandle
-  , spawnPipe'
-  , spawnPipe
-  , spawnPipeArgs
+  -- , spawnPipe'
+  -- , spawnPipe
+  -- , spawnPipeArgs
   , createProcess'
   , readCreateProcessWithExitCode'
   , proc'
@@ -82,15 +82,15 @@ spawn = io . void . createProcess' . shell'
 spawnAt :: MonadIO m => FilePath -> String -> m ()
 spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }
 
-spawnPipe' :: CreateProcess -> IO (Handle, ProcessHandle)
-spawnPipe' cp = do
-  -- ASSUME creating a pipe will always succeed in making a Just Handle
-  (Just h, _, _, p) <- createProcess' $ cp { std_in = CreatePipe }
-  hSetBuffering h LineBuffering
-  return (h, p)
+-- spawnPipe' :: CreateProcess -> IO (Handle, ProcessHandle)
+-- spawnPipe' cp = do
+--   -- ASSUME creating a pipe will always succeed in making a Just Handle
+--   (Just h, _, _, p) <- createProcess' $ cp { std_in = CreatePipe }
+--   hSetBuffering h LineBuffering
+--   return (h, p)
 
-spawnPipe :: String -> IO (Handle, ProcessHandle)
-spawnPipe = spawnPipe' . shell
+-- spawnPipe :: String -> IO (Handle, ProcessHandle)
+-- spawnPipe = spawnPipe' . shell
 
-spawnPipeArgs :: FilePath -> [String] -> IO (Handle, ProcessHandle)
-spawnPipeArgs cmd = spawnPipe' . proc cmd
+-- spawnPipeArgs :: FilePath -> [String] -> IO (Handle, ProcessHandle)
+-- spawnPipeArgs cmd = spawnPipe' . proc cmd

From 6526f5e309210816a0d930b195218736bb78858e Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 27 Dec 2022 19:39:16 -0500
Subject: [PATCH 008/118] ENH use rio process for deps

---
 bin/xmobar.hs                   |  4 +--
 bin/xmonad.hs                   | 26 +-------------
 lib/Data/Internal/Dependency.hs | 64 +++++++++++++++++----------------
 3 files changed, 37 insertions(+), 57 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 1afbe6d..e7b4358 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -214,14 +214,14 @@ getBattery = iconIO_ "battery level indicator" xpfBattery root tree
   where
     root useIcon = IORoot_ (batteryCmd useIcon)
     tree = Only_ $ IOTest_ "Test if battery is present" []
-      $ fmap (Msg LevelError) <$> hasBattery
+      $ io $ fmap (Msg LevelError) <$> hasBattery
 
 getVPN :: Maybe SysClient -> BarFeature
 getVPN cl = iconDBus_ "VPN status indicator" xpfVPN root $ toAnd_ vpnDep test
   where
     root useIcon tree = DBusRoot_ (const $ vpnCmd useIcon) tree cl
     test = DBusIO $ IOTest_ "Use nmcli to test if VPN is present"
-      networkManagerPkgs vpnPresent
+      networkManagerPkgs $ io vpnPresent
 
 getBt :: Maybe SysClient -> BarFeature
 getBt = xmobarDBus "bluetooth status indicator" xpfBluetooth btDep btCmd
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index f01daaa..4f9aa5f 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -79,7 +79,6 @@ parse ["--deps"] = withCache printDeps
 parse ["--test"] = void $ withCache . evalConf =<< connectDBusX
 parse _          = usage
 
-
 run :: IO ()
 run = do
   -- These first two commands are only significant when xmonad is restarted.
@@ -150,38 +149,17 @@ features cl = FeatureSet
 evalConf db@DBusState { dbSysClient = cl } = do
   -- start DBus interfaces first since many features after this test these
   -- interfaces as dependencies
-  io $ putStrLn "hi"
-  -- io $ hFlush stdout
   let fs = features cl
   tt <- evalAlways $ fsTabbedTheme fs
-  io $ putStrLn "tabbed theme started"
-  -- io $ hFlush stdout
-  -- io $ print =<< readCreateProcessWithExitCode (proc "echo" ["hi"]) ""
   startDBusInterfaces fs
-  io $ putStrLn "dbus started"
-  -- io $ hFlush stdout
   (xmobarHandle, ts) <- startChildDaemons fs
-  io $ putStrLn "child daemons started"
-  -- io $ hFlush stdout
   startRemovableMon fs
-  io $ putStrLn "removemon started"
-  -- io $ hFlush stdout
   startPowerMon fs
-  io $ putStrLn "powermon started"
-  -- io $ hFlush stdout
   dws <- startDynWorkspaces fs
-  io $ putStrLn "dyn workspace started"
-  -- io $ hFlush stdout
   -- fb <- evalAlways $ fsFontBuilder features
   kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
-  io $ putStrLn "keys started"
-  -- io $ hFlush stdout
   sk <- evalAlways $ fsShowKeys fs
-  io $ putStrLn "showkeys started"
-  -- io $ hFlush stdout
   ha <- evalAlways $ fsACPIHandler fs
-  io $ putStrLn "acpi handler started"
-  -- io $ hFlush stdout
   return $ ewmh
     $ addKeymap dws sk kbs
     $ docks
@@ -207,9 +185,7 @@ evalConf db@DBusState { dbSysClient = cl } = do
       io $ case h of
         Just h' -> hSetBuffering h' LineBuffering
         Nothing -> return ()
-      --installSignalHandlers
       ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
-      -- uninstallSignalHandlers
       return (h, ThreadState (p:ps) $ maybeToList h)
     startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
                         $ dbSysClient db
@@ -315,7 +291,7 @@ vmDynamicWorkspace = Sometimes "virtualbox workspace" xpfVirtualBox
   [Subfeature root "windows 8 VM"]
   where
     root = IORoot_ dw $ toAnd_ (sysExe [Package Official "virtualbox"] "VBoxManage")
-      $ IOTest_ name [] $ vmExists vm
+      $ IOTest_ name [] $ io $ vmExists vm
     name = T.unwords ["test if", vm, "exists"]
     c = "VirtualBoxVM"
     vm = "win8raw"
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index 9b7b563..e0b4a1c 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -110,7 +110,7 @@ import           Control.Monad.IO.Class
 import           Control.Monad.Identity
 import           Control.Monad.Reader
 
-import           Data.Aeson              hiding (Error, Result)
+import           Data.Aeson             hiding (Error, Result)
 import           Data.Aeson.Key
 import           Data.Bifunctor
 import           Data.Either
@@ -119,23 +119,23 @@ import           Data.List
 import           Data.Maybe
 import           Data.Yaml
 
-import           GHC.IO.Exception        (ioe_description)
+import           GHC.IO.Exception       (ioe_description)
 
-import           DBus                    hiding (typeOf)
-import qualified DBus.Introspection      as I
+import           DBus                   hiding (typeOf)
+import qualified DBus.Introspection     as I
 
-import           RIO                     hiding (bracket, fromString)
+import           RIO                    hiding (bracket, fromString)
 import           RIO.FilePath
-import qualified RIO.Text                as T
+import           RIO.Process            hiding (findExecutable)
+import qualified RIO.Text               as T
 
 import           System.Directory
 import           System.Environment
 import           System.IO.Error
 import           System.Posix.Files
 
-import           XMonad.Core             (X, io)
+import           XMonad.Core            (X, io)
 import           XMonad.Internal.IO
-import           XMonad.Internal.Process
 import           XMonad.Internal.Shell
 import           XMonad.Internal.Theme
 
@@ -150,9 +150,10 @@ import           XMonad.Internal.Theme
 withCache :: FIO a -> IO a
 withCache x = do
   logOpts <- logOptionsHandle stderr False
+  pc <- mkDefaultProcessContext
   withLogFunc logOpts $ \f -> do
     p <- getParams
-    let s = DepStage f p
+    let s = DepStage f pc p
     runRIO s x
 
 -- | Execute an Always immediately
@@ -315,7 +316,7 @@ data DBusDependency_ c = Bus [Fulfillment] BusName
 
 -- | A dependency that only requires IO to evaluate (no payload)
 data IODependency_ = IOSystem_ [Fulfillment] SystemDependency
-  | IOTest_ T.Text [Fulfillment] (IO (Maybe Msg))
+  | IOTest_ T.Text [Fulfillment] (FIO (Maybe Msg))
   | forall a. IOSometimes_ (Sometimes a)
 
 -- | A system component to an IODependency
@@ -385,13 +386,16 @@ data PostFail = PostFail [Msg] | PostMissing Msg
 type FIO a = RIO DepStage a
 
 data DepStage = DepStage
-  { dsLogFun :: !LogFunc
-  , dsParams :: !XParams
+  { dsLogFun  :: !LogFunc
+  , dsProcCxt :: !ProcessContext
+  , dsParams  :: !XParams
   }
 
 instance HasLogFunc DepStage where
   logFuncL = lens dsLogFun (\x y -> x { dsLogFun = y })
 
+instance HasProcessContext DepStage where
+  processContextL = lens dsProcCxt (\x y -> x { dsProcCxt = y })
 
 data XParams = XParams
   { xpLogLevel :: LogLevel
@@ -645,27 +649,27 @@ testIODep_ :: IODependency_ -> FIO MResult_
 testIODep_ d = memoizeMVar $ testIODepNoCache_ d
 
 testIODepNoCache_ :: IODependency_ -> FIO Result_
-testIODepNoCache_ (IOSystem_ _ s) = io $ readResult_ <$> testSysDependency s
-testIODepNoCache_ (IOTest_ _ _ t) = io $ readResult_ <$> t
+testIODepNoCache_ (IOSystem_ _ s) = readResult_ <$> testSysDependency s
+testIODepNoCache_ (IOTest_ _ _ t) = readResult_ <$> t
 testIODepNoCache_ (IOSometimes_ x) = bimap (fmap stripMsg) (fmap stripMsg . snd)
   <$> evalSometimesMsg x
 
 --------------------------------------------------------------------------------
 -- | System Dependency Testing
 
-testSysDependency :: SystemDependency -> IO (Maybe Msg)
-testSysDependency (Executable sys bin) = maybe (Just msg) (const Nothing)
+testSysDependency :: SystemDependency -> FIO (Maybe Msg)
+testSysDependency (Executable sys bin) = io $ maybe (Just msg) (const Nothing)
   <$> findExecutable bin
   where
     msg = Msg LevelError $ T.unwords [e, "executable", singleQuote $ T.pack bin, "not found"]
     e = if sys then "system" else "local"
-testSysDependency (Systemd t n) = shellTest cmd msg
+testSysDependency (Systemd t n) = shellTest "systemctl" args msg
   where
     msg = T.unwords ["systemd", unitType t, "unit", singleQuote n, "not found"]
-    cmd = fmtCmd "systemctl" $ ["--user" | t == UserUnit] ++ ["status", n]
-testSysDependency (Process n) = shellTest (fmtCmd "pidof" [n])
+    args = ["--user" | t == UserUnit] ++ ["status", n]
+testSysDependency (Process n) = shellTest "pidof" [n]
   $ T.unwords ["Process", singleQuote n, "not found"]
-testSysDependency (AccessiblePath p r w) = permMsg <$> getPermissionsSafe p
+testSysDependency (AccessiblePath p r w) = io $ permMsg <$> getPermissionsSafe p
   where
     testPerm False _ _  = Nothing
     testPerm True f res = Just $ f res
@@ -679,9 +683,9 @@ testSysDependency (AccessiblePath p r w) = permMsg <$> getPermissionsSafe p
         (_, Just False)          -> mkErr "file not writable"
         _                        -> Nothing
 
-shellTest :: T.Text -> T.Text -> IO (Maybe Msg)
-shellTest cmd msg = do
-  (rc, _, _) <- readCreateProcessWithExitCode (shell $ T.unpack cmd) ""
+shellTest :: FilePath -> [T.Text] -> T.Text -> FIO (Maybe Msg)
+shellTest cmd args msg = do
+  rc <- proc cmd (T.unpack <$> args) runProcess
   return $ case rc of
     ExitSuccess -> Nothing
     _           -> Just $ Msg LevelError msg
@@ -722,19 +726,19 @@ fontDependency :: T.Text -> [Fulfillment] -> IODependency FontBuilder
 fontDependency fam ful = IORead (fontTestName fam) ful $ testFont fam
 
 fontDependency_ :: T.Text -> [Fulfillment] -> IODependency_
-fontDependency_ fam ful = IOTest_ (fontTestName fam) ful $ voidRead <$> testFont' fam
+fontDependency_ fam ful = IOTest_ (fontTestName fam) ful $ voidRead <$> testFont fam
 
 fontTestName :: T.Text -> T.Text
 fontTestName fam = T.unwords ["test if font", singleQuote fam, "exists"]
 
-testFont :: T.Text -> FIO (Result FontBuilder)
-testFont = liftIO . testFont'
+-- testFont :: T.Text -> FIO (Result FontBuilder)
+-- testFont = liftIO . testFont'
 
-testFont' :: T.Text -> IO (Result FontBuilder)
-testFont' fam = maybe pass (Left . (:[])) <$> shellTest cmd msg
+testFont :: T.Text -> FIO (Result FontBuilder)
+testFont fam = maybe pass (Left . (:[])) <$> shellTest "fc-list" args msg
   where
     msg = T.unwords ["font family", qFam, "not found"]
-    cmd = fmtCmd "fc-list" ["-q", qFam]
+    args = [qFam]
     qFam = singleQuote fam
     pass = Right $ PostPass (buildFont $ Just fam) []
 
@@ -781,7 +785,7 @@ readInterface n f = IORead n [] go
 
 socketExists :: T.Text -> [Fulfillment] -> IO FilePath -> IODependency_
 socketExists n ful = IOTest_ (T.unwords ["test if", n, "socket exists"]) ful
-  . socketExists'
+  . io . socketExists'
 
 socketExists' :: IO FilePath -> IO (Maybe Msg)
 socketExists' getPath = do

From 780c600d477a2f5951eb34b8e94916945fc65e7a Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 27 Dec 2022 22:09:23 -0500
Subject: [PATCH 009/118] ENH use rio proc for xmobar startup

---
 bin/xmonad.hs | 38 ++++++++++++++++++++++----------------
 1 file changed, 22 insertions(+), 16 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 4f9aa5f..97140e8 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -21,6 +21,7 @@ import           Graphics.X11.Xlib.Atom
 import           Graphics.X11.Xlib.Extras
 
 import           RIO                                            (async)
+import           RIO.Process
 import qualified RIO.Text                                       as T
 
 import           System.Directory
@@ -29,7 +30,10 @@ import           System.IO                                      hiding
     ( hPutStrLn
     )
 import           System.IO.Error
-import           System.Process
+import           System.Process                                 hiding
+    ( createPipe
+    , proc
+    )
 
 import           XMonad
 import           XMonad.Actions.CopyWindow
@@ -53,7 +57,7 @@ import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Control
 import           XMonad.Internal.DBus.Removable
 import           XMonad.Internal.DBus.Screensaver
-import           XMonad.Internal.Process
+import           XMonad.Internal.Process                        (killHandle)
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme                          as XT
 import           XMonad.Layout.MultiToggle
@@ -152,7 +156,7 @@ evalConf db@DBusState { dbSysClient = cl } = do
   let fs = features cl
   tt <- evalAlways $ fsTabbedTheme fs
   startDBusInterfaces fs
-  (xmobarHandle, ts) <- startChildDaemons fs
+  ts <- startChildDaemons fs
   startRemovableMon fs
   startPowerMon fs
   dws <- startDynWorkspaces fs
@@ -170,7 +174,7 @@ evalConf db@DBusState { dbSysClient = cl } = do
           , handleEventHook = myEventHook ha
           , startupHook = myStartupHook
           , workspaces = myWorkspaces
-          , logHook = maybe logViewports myLoghook xmobarHandle
+          , logHook = maybe logViewports myLoghook $ tsXmobar ts
           , clickJustFocuses = False
           , focusFollowsMouse = False
           , normalBorderColor = T.unpack XT.bordersColor
@@ -181,12 +185,14 @@ evalConf db@DBusState { dbSysClient = cl } = do
     startDBusInterfaces fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
       $ fsDBusExporters fs
     startChildDaemons fs = do
-      (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe }
-      io $ case h of
-        Just h' -> hSetBuffering h' LineBuffering
-        Nothing -> return ()
+      p <- proc "xmobar" [] (startProcess . setStdin createPipe)
+      -- (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe }
+      io $ hSetBuffering (getStdin p) LineBuffering
+      -- io $ case h of
+      --   Just h' -> hSetBuffering h' LineBuffering
+      --   Nothing -> return ()
       ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
-      return (h, ThreadState (p:ps) $ maybeToList h)
+      return $ ThreadState ps $ Just p
     startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
                         $ dbSysClient db
     startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
@@ -215,7 +221,7 @@ allFeatures db = do
   let others = [runRemovableMon $ dbSysClient db, runPowermon]
   return (dbus ++ others, Left runScreenLock:bfs, allDWs')
   where
-    ts = ThreadState { tsChildPIDs = [], tsChildHandles = [] }
+    ts = ThreadState { tsChildPIDs = [], tsXmobar = Nothing }
 
 usage :: IO ()
 usage = putStrLn $ intercalate "\n"
@@ -227,8 +233,8 @@ usage = putStrLn $ intercalate "\n"
 -- | Concurrency configuration
 
 data ThreadState = ThreadState
-    { tsChildPIDs    :: [ProcessHandle]
-    , tsChildHandles :: [Handle]
+    { tsChildPIDs :: [ProcessHandle]
+    , tsXmobar    :: Maybe (Process Handle () ())
     }
 
 -- TODO shouldn't this be run by a signal handler?
@@ -395,7 +401,7 @@ runHide = sendMessage $ Toggle HIDE
 -- | Loghook configuration
 --
 
-myLoghook :: Handle -> X ()
+myLoghook :: Process Handle () () -> X ()
 myLoghook h = do
   logXinerama h
   logViewports
@@ -452,9 +458,9 @@ whenChanged v action = do
 -- screen. The "<>" is the workspace that currently has focus. N is the number
 -- of windows on the current workspace.
 
-logXinerama :: Handle -> X ()
-logXinerama h = withWindowSet $ \ws -> io
-  $ hPutStrLn h
+logXinerama :: Process Handle () () -> X ()
+logXinerama p = withWindowSet $ \ws -> io
+  $ hPutStrLn (getStdin p)
   $ T.unwords
   $ filter (not . T.null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws]
   where

From 59c483785a8e176201e3c54d4afa93b3fca3fa5d Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Wed, 28 Dec 2022 00:04:33 -0500
Subject: [PATCH 010/118] ENH clean up xmobar properly

---
 bin/xmonad.hs                   | 12 +++++++-----
 lib/Data/Internal/Dependency.hs |  3 ++-
 package.yaml                    |  1 +
 3 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 97140e8..81952e3 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -20,7 +20,10 @@ import           Graphics.X11.Types
 import           Graphics.X11.Xlib.Atom
 import           Graphics.X11.Xlib.Extras
 
-import           RIO                                            (async)
+import           RIO
+    ( async
+    , handleIO
+    )
 import           RIO.Process
 import qualified RIO.Text                                       as T
 
@@ -186,11 +189,7 @@ evalConf db@DBusState { dbSysClient = cl } = do
       $ fsDBusExporters fs
     startChildDaemons fs = do
       p <- proc "xmobar" [] (startProcess . setStdin createPipe)
-      -- (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe }
       io $ hSetBuffering (getStdin p) LineBuffering
-      -- io $ case h of
-      --   Just h' -> hSetBuffering h' LineBuffering
-      --   Nothing -> return ()
       ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
       return $ ThreadState ps $ Just p
     startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
@@ -240,8 +239,11 @@ data ThreadState = ThreadState
 -- TODO shouldn't this be run by a signal handler?
 runCleanup :: ThreadState -> DBusState -> X ()
 runCleanup ts db = io $ do
+  mapM_ stopNoWait $ tsXmobar ts
   mapM_ killHandle $ tsChildPIDs ts
   disconnectDBusX db
+  where
+    stopNoWait p = handleIO (\_ -> return ()) $ stopProcess p
 
 --------------------------------------------------------------------------------
 -- | Startuphook configuration
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index e0b4a1c..4a5ef65 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -133,6 +133,7 @@ import           System.Directory
 import           System.Environment
 import           System.IO.Error
 import           System.Posix.Files
+import           System.Process.Typed   (nullStream)
 
 import           XMonad.Core            (X, io)
 import           XMonad.Internal.IO
@@ -685,7 +686,7 @@ testSysDependency (AccessiblePath p r w) = io $ permMsg <$> getPermissionsSafe p
 
 shellTest :: FilePath -> [T.Text] -> T.Text -> FIO (Maybe Msg)
 shellTest cmd args msg = do
-  rc <- proc cmd (T.unpack <$> args) runProcess
+  rc <- proc cmd (T.unpack <$> args) (runProcess . setStdout nullStream)
   return $ case rc of
     ExitSuccess -> Nothing
     _           -> Just $ Msg LevelError msg
diff --git a/package.yaml b/package.yaml
index 4d2ae55..cbffa4e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -41,6 +41,7 @@ dependencies:
   - xml >= 1.3.14
   - lifted-base >= 0.2.3.12
   - utf8-string >= 1.0.2
+  - typed-process >= 0.2.8.0
 
 library:
   source-dirs: lib/

From 87394dd6a9bcd52dfdeca6a7c156d9a35d07b40c Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Wed, 28 Dec 2022 00:46:48 -0500
Subject: [PATCH 011/118] ENH put entire runtime in rio

---
 bin/xmonad.hs | 164 ++++++++++++++++++++++++++++++++++----------------
 1 file changed, 111 insertions(+), 53 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 81952e3..19e292a 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -22,6 +22,7 @@ import           Graphics.X11.Xlib.Extras
 
 import           RIO
     ( async
+    , bracket
     , handleIO
     )
 import           RIO.Process
@@ -83,7 +84,7 @@ main = getArgs >>= parse
 parse :: [String] -> IO ()
 parse []         = run
 parse ["--deps"] = withCache printDeps
-parse ["--test"] = void $ withCache . evalConf =<< connectDBusX
+-- parse ["--test"] = void $ withCache . evalConf =<< connectDBusX
 parse _          = usage
 
 run :: IO ()
@@ -101,12 +102,54 @@ run = do
   -- signal handlers to carry over to the top.
   uninstallSignalHandlers
   hSetBuffering stdout LineBuffering
-  db <- connectDBusX
-  conf <- withCache $ evalConf db
-  ds <- getCreateDirectories
-  -- IDK why this is necessary; nothing prior to this will print if missing
-  -- hFlush stdout
-  launch conf ds
+  withCache $ do
+    bracket (io connectDBusX) (io . disconnectDBus) $ \db -> do
+      -- conf <- evalConf db
+      -- ds <- io getCreateDirectories
+      -- io $ launch conf ds
+      let sys = dbSysClient db
+      let fs = features sys
+      startDBusInterfaces db fs
+      withXmobar $ \xmobarP -> do
+        withChildDaemons fs $ \ds -> do
+          let ts = ThreadState ds (Just xmobarP)
+          startRemovableMon db fs
+          startPowerMon fs
+          dws <- startDynWorkspaces fs
+          kbs <- filterExternal <$> evalExternal (fsKeys fs ts 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
+                      }
+          dirs <- io getCreateDirectories
+          io $ launch conf dirs
+  where
+    startRemovableMon db fs = void $ executeSometimes $ fsRemovableMon fs
+                        $ dbSysClient db
+    startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
+    startDynWorkspaces fs = do
+      dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
+      void $ io $ async $ runWorkspaceMon dws
+      return dws
+
+startDBusInterfaces :: DBusState -> FeatureSet -> FIO ()
+startDBusInterfaces db fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
+  $ fsDBusExporters fs
 
 getCreateDirectories :: IO Directories
 getCreateDirectories = do
@@ -153,52 +196,67 @@ features cl = FeatureSet
   , fsDaemons = [runNetAppDaemon cl, runAutolock]
   }
 
-evalConf db@DBusState { dbSysClient = cl } = do
-  -- start DBus interfaces first since many features after this test these
-  -- interfaces as dependencies
-  let fs = features cl
-  tt <- evalAlways $ fsTabbedTheme fs
-  startDBusInterfaces fs
-  ts <- startChildDaemons fs
-  startRemovableMon fs
-  startPowerMon fs
-  dws <- startDynWorkspaces fs
-  -- fb <- evalAlways $ fsFontBuilder features
-  kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
-  sk <- evalAlways $ fsShowKeys fs
-  ha <- evalAlways $ fsACPIHandler fs
-  return $ 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 = maybe logViewports myLoghook $ tsXmobar ts
-          , clickJustFocuses = False
-          , focusFollowsMouse = False
-          , normalBorderColor = T.unpack XT.bordersColor
-          , focusedBorderColor = T.unpack XT.selectedBordersColor
-          }
-  where
-    forkIO_ = void . async
-    startDBusInterfaces fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
-      $ fsDBusExporters fs
-    startChildDaemons fs = do
-      p <- proc "xmobar" [] (startProcess . setStdin createPipe)
-      io $ hSetBuffering (getStdin p) LineBuffering
-      ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
-      return $ ThreadState ps $ Just p
-    startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
-                        $ dbSysClient db
-    startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
-    startDynWorkspaces fs = do
-      dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
-      io $ forkIO_ $ runWorkspaceMon dws
-      return dws
+-- evalConf db@DBusState { dbSysClient = cl } = do
+--   -- start DBus interfaces first since many features after this test these
+--   -- interfaces as dependencies
+--   let fs = features cl
+--   tt <- evalAlways $ fsTabbedTheme fs
+--   startDBusInterfaces fs
+--   ts <- startChildDaemons fs
+--   startRemovableMon fs
+--   startPowerMon fs
+--   dws <- startDynWorkspaces fs
+--   -- fb <- evalAlways $ fsFontBuilder features
+--   kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
+--   sk <- evalAlways $ fsShowKeys fs
+--   ha <- evalAlways $ fsACPIHandler fs
+--   return $ 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 = maybe logViewports myLoghook $ tsXmobar ts
+--           , clickJustFocuses = False
+--           , focusFollowsMouse = False
+--           , normalBorderColor = T.unpack XT.bordersColor
+--           , focusedBorderColor = T.unpack XT.selectedBordersColor
+--           }
+--   where
+--     forkIO_ = void . async
+--     startDBusInterfaces fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
+--       $ fsDBusExporters fs
+--     startChildDaemons fs = do
+--       p <- proc "xmobar" [] (startProcess . setStdin createPipe)
+--       io $ hSetBuffering (getStdin p) LineBuffering
+--       ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
+--       return $ ThreadState ps $ Just p
+--     startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
+--                         $ dbSysClient db
+--     startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
+--     startDynWorkspaces fs = do
+--       dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
+--       io $ forkIO_ $ runWorkspaceMon dws
+--       return dws
+
+startXmobar :: FIO (Process Handle () ())
+startXmobar = do
+  p <- proc "xmobar" [] (startProcess . setStdin createPipe)
+  io $ hSetBuffering (getStdin p) LineBuffering
+  return p
+
+startChildDaemons :: FeatureSet -> FIO [ProcessHandle]
+startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
+
+withChildDaemons :: FeatureSet -> ([ProcessHandle] -> FIO a) -> FIO a
+withChildDaemons fs = bracket (startChildDaemons fs) (mapM_ (io . killHandle))
+
+withXmobar :: (Process Handle () () -> FIO a) -> FIO a
+withXmobar = bracket startXmobar stopProcess
 
 printDeps :: FIO ()
 printDeps = do

From fb9b9fa65e48c3d8e31804681417d2694ec882f6 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Wed, 28 Dec 2022 12:19:44 -0500
Subject: [PATCH 012/118] WIP kinda get rio process to work for all
 subprocesses

---
 bin/xmonad.hs                                 | 124 +++++++-----------
 lib/Data/Internal/Dependency.hs               |   6 +-
 lib/XMonad/Internal/Command/Desktop.hs        |  10 +-
 lib/XMonad/Internal/Command/Power.hs          |  10 +-
 lib/XMonad/Internal/Concurrent/ACPIEvent.hs   |   2 +-
 lib/XMonad/Internal/DBus/Brightness/Common.hs |  14 +-
 lib/XMonad/Internal/DBus/Removable.hs         |   2 +-
 lib/XMonad/Internal/DBus/Screensaver.hs       |   8 +-
 8 files changed, 69 insertions(+), 107 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 19e292a..133598c 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
@@ -21,23 +22,13 @@ import           Graphics.X11.Xlib.Atom
 import           Graphics.X11.Xlib.Extras
 
 import           RIO
-    ( async
-    , bracket
-    , handleIO
-    )
+import           RIO.Directory
 import           RIO.Process
 import qualified RIO.Text                                       as T
 
-import           System.Directory
 import           System.Environment
-import           System.IO                                      hiding
-    ( hPutStrLn
-    )
-import           System.IO.Error
-import           System.Process                                 hiding
-    ( createPipe
-    , proc
-    )
+import           System.Posix.Signals
+import           System.Process                                 (getPid)
 
 import           XMonad
 import           XMonad.Actions.CopyWindow
@@ -61,7 +52,6 @@ import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Control
 import           XMonad.Internal.DBus.Removable
 import           XMonad.Internal.DBus.Screensaver
-import           XMonad.Internal.Process                        (killHandle)
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme                          as XT
 import           XMonad.Layout.MultiToggle
@@ -103,10 +93,7 @@ run = do
   uninstallSignalHandlers
   hSetBuffering stdout LineBuffering
   withCache $ do
-    bracket (io connectDBusX) (io . disconnectDBus) $ \db -> do
-      -- conf <- evalConf db
-      -- ds <- io getCreateDirectories
-      -- io $ launch conf ds
+    withDBusX $ \db -> do
       let sys = dbSysClient db
       let fs = features sys
       startDBusInterfaces db fs
@@ -136,8 +123,7 @@ run = do
                       , normalBorderColor = T.unpack XT.bordersColor
                       , focusedBorderColor = T.unpack XT.selectedBordersColor
                       }
-          dirs <- io getCreateDirectories
-          io $ launch conf dirs
+          io $ runXMonad conf
   where
     startRemovableMon db fs = void $ executeSometimes $ fsRemovableMon fs
                         $ dbSysClient db
@@ -147,6 +133,11 @@ run = do
       void $ io $ async $ runWorkspaceMon dws
       return dws
 
+runXMonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
+runXMonad conf = do
+  dirs <- getCreateDirectories
+  launch conf dirs
+
 startDBusInterfaces :: DBusState -> FeatureSet -> FIO ()
 startDBusInterfaces db fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
   $ fsDBusExporters fs
@@ -159,7 +150,7 @@ getCreateDirectories = do
   where
     createIfMissing ds f = do
       let d = f ds
-      r <- tryIOError $ createDirectoryIfMissing True d
+      r <- tryIO $ createDirectoryIfMissing True d
       case r of
         (Left e) -> print e
         _        -> return ()
@@ -169,7 +160,7 @@ data FeatureSet = FeatureSet
   , fsDBusExporters :: [Maybe SesClient -> SometimesIO]
   , fsPowerMon      :: SometimesIO
   , fsRemovableMon  :: Maybe SysClient -> SometimesIO
-  , fsDaemons       :: [Sometimes (IO ProcessHandle)]
+  , fsDaemons       :: [Sometimes (FIO (Process () () ()))]
   , fsACPIHandler   :: Always (String -> X ())
   , fsTabbedTheme   :: Always Theme
   , fsDynWorkspaces :: [Sometimes DynWorkspace]
@@ -196,67 +187,35 @@ features cl = FeatureSet
   , fsDaemons = [runNetAppDaemon cl, runAutolock]
   }
 
--- evalConf db@DBusState { dbSysClient = cl } = do
---   -- start DBus interfaces first since many features after this test these
---   -- interfaces as dependencies
---   let fs = features cl
---   tt <- evalAlways $ fsTabbedTheme fs
---   startDBusInterfaces fs
---   ts <- startChildDaemons fs
---   startRemovableMon fs
---   startPowerMon fs
---   dws <- startDynWorkspaces fs
---   -- fb <- evalAlways $ fsFontBuilder features
---   kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
---   sk <- evalAlways $ fsShowKeys fs
---   ha <- evalAlways $ fsACPIHandler fs
---   return $ 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 = maybe logViewports myLoghook $ tsXmobar ts
---           , clickJustFocuses = False
---           , focusFollowsMouse = False
---           , normalBorderColor = T.unpack XT.bordersColor
---           , focusedBorderColor = T.unpack XT.selectedBordersColor
---           }
---   where
---     forkIO_ = void . async
---     startDBusInterfaces fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
---       $ fsDBusExporters fs
---     startChildDaemons fs = do
---       p <- proc "xmobar" [] (startProcess . setStdin createPipe)
---       io $ hSetBuffering (getStdin p) LineBuffering
---       ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
---       return $ ThreadState ps $ Just p
---     startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
---                         $ dbSysClient db
---     startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
---     startDynWorkspaces fs = do
---       dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
---       io $ forkIO_ $ runWorkspaceMon dws
---       return dws
-
 startXmobar :: FIO (Process Handle () ())
 startXmobar = do
   p <- proc "xmobar" [] (startProcess . setStdin createPipe)
   io $ hSetBuffering (getStdin p) LineBuffering
   return p
 
-startChildDaemons :: FeatureSet -> FIO [ProcessHandle]
+startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
 
-withChildDaemons :: FeatureSet -> ([ProcessHandle] -> FIO a) -> FIO a
-withChildDaemons fs = bracket (startChildDaemons fs) (mapM_ (io . killHandle))
+withDBusX :: (DBusState -> FIO a) -> FIO a
+withDBusX = bracket (io connectDBusX) cleanup
+  where
+    cleanup db = do
+      logInfo "unregistering xmonad from DBus"
+      io $ disconnectDBus db
+
+withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
+withChildDaemons fs = bracket (startChildDaemons fs) cleanup
+  where
+    cleanup ps = do
+      logInfo "stopping child processes"
+      mapM_ stopProcess ps
 
 withXmobar :: (Process Handle () () -> FIO a) -> FIO a
-withXmobar = bracket startXmobar stopProcess
+withXmobar = bracket startXmobar cleanup
+  where
+    cleanup p = do
+      logInfo "stopping xmobar child process"
+      stopProcess p
 
 printDeps :: FIO ()
 printDeps = do
@@ -290,18 +249,23 @@ usage = putStrLn $ intercalate "\n"
 -- | Concurrency configuration
 
 data ThreadState = ThreadState
-    { tsChildPIDs :: [ProcessHandle]
+    { tsChildPIDs :: [Process () () ()]
     , tsXmobar    :: Maybe (Process Handle () ())
     }
 
--- TODO shouldn't this be run by a signal handler?
 runCleanup :: ThreadState -> DBusState -> X ()
 runCleanup ts db = io $ do
-  mapM_ stopNoWait $ tsXmobar ts
-  mapM_ killHandle $ tsChildPIDs ts
-  disconnectDBusX db
+  mapM_ killNoWait $ tsXmobar ts
+  finally (mapM_ killNoWait $ tsChildPIDs ts) $
+    disconnectDBusX db
   where
     stopNoWait p = handleIO (\_ -> return ()) $ stopProcess p
+    killNoWait p = do
+      let ph = unsafeProcessHandle p
+      i <- getPid ph
+      forM_ i $ signalProcess sigTERM
+      -- terminateProcess ph
+      stopNoWait p
 
 --------------------------------------------------------------------------------
 -- | Startuphook configuration
@@ -777,14 +741,14 @@ externalBindings ts db =
     , KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
     , KeyBinding "M-<F9>" "toggle ethernet" $ Left runToggleEthernet
     , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ runToggleBluetooth sys
-    , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ ioSometimes $ callToggle ses
+    , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ callToggle ses
     , KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt
     ]
   ]
   where
     ses = dbSesClient db
     sys = dbSysClient db
-    brightessControls ctl getter = (ioSometimes . getter . ctl) ses
+    brightessControls ctl getter = (getter . ctl) ses
     ib = Left . brightessControls intelBacklightControls
     ck = Left . brightessControls clevoKeyboardControls
     ftrAlways n = Right . Always n . Always_ . FallbackAlone
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index 4a5ef65..4814dc2 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -162,8 +162,8 @@ executeAlways :: Always (IO a) -> FIO a
 executeAlways = io <=< evalAlways
 
 -- | Execute a Sometimes immediately (or do nothing if failure)
-executeSometimes :: Sometimes (IO a) -> FIO (Maybe a)
-executeSometimes a = maybe (return Nothing) (io . fmap Just) =<< evalSometimes a
+executeSometimes :: Sometimes (FIO a) -> FIO (Maybe a)
+executeSometimes a = maybe (return Nothing) (fmap Just) =<< evalSometimes a
 
 -- | Possibly return the action of an Always/Sometimes
 evalFeature :: Feature a -> FIO (Maybe a)
@@ -228,7 +228,7 @@ type AlwaysIO = Always (IO ())
 
 type SometimesX = Sometimes (X ())
 
-type SometimesIO = Sometimes (IO ())
+type SometimesIO = Sometimes (FIO ())
 
 type Feature a = Either (Sometimes a) (Always a)
 
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index b5270a0..eb6d58f 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -41,7 +41,6 @@ module XMonad.Internal.Command.Desktop
   , networkManagerPkgs
   ) where
 
-import           Control.Monad               (void)
 import           Control.Monad.IO.Class
 
 import           Data.Internal.DBus
@@ -49,19 +48,20 @@ import           Data.Internal.Dependency
 
 import           DBus
 
+import           RIO
 import           RIO.FilePath
+import           RIO.Process
 import qualified RIO.Text                    as T
 
 import           System.Directory
 import           System.Environment
 import           System.Posix.User
 
-import           XMonad                      (asks)
 import           XMonad.Actions.Volume
 import           XMonad.Core                 hiding (spawn)
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Notify
-import           XMonad.Internal.Process
+import           XMonad.Internal.Process     hiding (createPipe, proc)
 import           XMonad.Internal.Shell
 import           XMonad.Operations
 
@@ -251,13 +251,13 @@ runNotificationContext =
 -- | System commands
 
 -- this is required for some vpn's to work properly with network-manager
-runNetAppDaemon :: Maybe SysClient -> Sometimes (IO ProcessHandle)
+runNetAppDaemon :: Maybe SysClient -> Sometimes (FIO (Process () () ()))
 runNetAppDaemon cl = Sometimes "network applet" xpfVPN
   [Subfeature (DBusRoot_ cmd tree cl) "NM-applet"]
   where
     tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
     app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
-    cmd _ = spawnProcess "nm-applet" []
+    cmd _ = proc "nm-applet" [] startProcess
 
 runToggleBluetooth :: Maybe SysClient -> SometimesX
 runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index df4b86a..2af7922 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -27,8 +27,6 @@ module XMonad.Internal.Command.Power
   , promptFontDep
   ) where
 
-import           Control.Arrow               (first)
-
 import           Data.Internal.Dependency
 
 import           Data.Either
@@ -36,13 +34,13 @@ import qualified Data.Map                    as M
 
 import           Graphics.X11.Types
 
+import           RIO
 import           RIO.FilePath
+import           RIO.Process
 import qualified RIO.Text                    as T
 
 import           System.Directory
-import           System.Exit
 import           System.IO.Error
-import           System.Process              (ProcessHandle, spawnProcess)
 
 import           XMonad.Core
 import           XMonad.Internal.Shell
@@ -90,12 +88,12 @@ runReboot = spawn "systemctl reboot"
 --------------------------------------------------------------------------------
 -- | Autolock
 
-runAutolock :: Sometimes (IO ProcessHandle)
+runAutolock :: Sometimes (FIO (Process () () ()))
 runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
   where
     tree = And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock")
       $ Only_ $ IOSometimes_ runScreenLock
-    cmd = spawnProcess "xss-lock" ["--ignore-sleep", "screenlock"]
+    cmd = proc "xss-lock" ["--ignore-sleep", "screenlock"] startProcess
 
 --------------------------------------------------------------------------------
 -- | Confirmation prompts
diff --git a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
index 4e12f36..1c9761b 100644
--- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
+++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
@@ -113,7 +113,7 @@ handleACPI fb lock tag = do
 -- | Spawn a new thread that will listen for ACPI events on the acpid socket
 -- and send ClientMessage events when it receives them
 runPowermon :: SometimesIO
-runPowermon = sometimesIO_ "ACPI event monitor" "acpid" socketDep listenACPI
+runPowermon = sometimesIO_ "ACPI event monitor" "acpid" socketDep $ io listenACPI
 
 runHandleACPI :: Always (String -> X ())
 runHandleACPI = Always "ACPI event handler" $ Option sf fallback
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 7e43837..8146055 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -50,10 +50,10 @@ data BrightnessConfig a b = BrightnessConfig
   }
 
 data BrightnessControls = BrightnessControls
-  { bctlMax :: SometimesIO
-  , bctlMin :: SometimesIO
-  , bctlInc :: SometimesIO
-  , bctlDec :: SometimesIO
+  { bctlMax :: SometimesX
+  , bctlMin :: SometimesX
+  , bctlInc :: SometimesX
+  , bctlDec :: SometimesX
   }
 
 brightnessControls :: XPQuery -> BrightnessConfig a b -> Maybe SesClient
@@ -101,8 +101,8 @@ brightnessExporter q ful deps bc@BrightnessConfig { bcName = n } cl =
     root = DBusRoot_ (exportBrightnessControls' bc) tree cl
     tree = listToAnds (Bus ful xmonadBusName) $ fmap DBusIO deps
 
-exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> SesClient -> IO ()
-exportBrightnessControls' bc cl = do
+exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> SesClient -> FIO ()
+exportBrightnessControls' bc cl = io $ do
   let ses = toClient cl
   maxval <- bcGetMax bc -- assume the max value will never change
   let bounds = (bcMinRaw bc, maxval)
@@ -138,7 +138,7 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
     sig = signal p i memCur
 
 callBacklight :: XPQuery -> Maybe SesClient -> BrightnessConfig a b -> T.Text
-  -> MemberName -> SometimesIO
+  -> MemberName -> SometimesX
 callBacklight q cl BrightnessConfig { bcPath = p
                                     , bcInterface = i
                                     , bcName = n } controlName m =
diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs
index f909346..e891314 100644
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@@ -86,6 +86,6 @@ listenDevices cl = do
 
 runRemovableMon :: Maybe SysClient -> SometimesIO
 runRemovableMon cl =
-  sometimesDBus cl "removeable device monitor" "dbus monitor" deps listenDevices
+  sometimesDBus cl "removeable device monitor" "dbus monitor" deps $ io . listenDevices
   where
     deps = toAnd_ addedDep removedDep
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 83463f2..56dd086 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -11,11 +11,11 @@ module XMonad.Internal.DBus.Screensaver
   , ssSignalDep
   ) where
 
-import           Control.Monad               (void)
-
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
+import           RIO
+
 import           DBus
 import           DBus.Client
 import qualified DBus.Introspection          as I
@@ -102,7 +102,7 @@ exportScreensaver ses =
   sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) cmd
   where
     cmd cl = let cl' = toClient cl in
-      export cl' ssPath defaultInterface
+      liftIO $ export cl' ssPath defaultInterface
       { interfaceName = interface
       , interfaceMethods =
         [ autoMethod memToggle $ emitState cl' =<< toggle
@@ -123,7 +123,7 @@ exportScreensaver ses =
     bus = Bus [] xmonadBusName
     ssx = DBusIO $ sysExe [Package Official "xorg-xset"] ssExecutable
 
-callToggle :: Maybe SesClient -> SometimesIO
+callToggle :: Maybe SesClient -> SometimesX
 callToggle = sometimesEndpoint "screensaver toggle" "dbus switch" []
   xmonadBusName ssPath interface memToggle
 

From a6ef4c8c500aade359c8fa55a0facabcb5850f61 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Wed, 28 Dec 2022 13:29:35 -0500
Subject: [PATCH 013/118] ENH make sure child processes are also killed

---
 bin/xmonad.hs                          | 5 ++---
 lib/XMonad/Internal/Command/Desktop.hs | 2 +-
 lib/XMonad/Internal/Command/Power.hs   | 2 +-
 3 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 133598c..2c8eb31 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -189,7 +189,7 @@ features cl = FeatureSet
 
 startXmobar :: FIO (Process Handle () ())
 startXmobar = do
-  p <- proc "xmobar" [] (startProcess . setStdin createPipe)
+  p <- proc "xmobar" [] (startProcess . setStdin createPipe . setCreateGroup True)
   io $ hSetBuffering (getStdin p) LineBuffering
   return p
 
@@ -263,8 +263,7 @@ runCleanup ts db = io $ do
     killNoWait p = do
       let ph = unsafeProcessHandle p
       i <- getPid ph
-      forM_ i $ signalProcess sigTERM
-      -- terminateProcess ph
+      forM_ i $ signalProcessGroup sigTERM
       stopNoWait p
 
 --------------------------------------------------------------------------------
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index eb6d58f..724606d 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -257,7 +257,7 @@ runNetAppDaemon cl = Sometimes "network applet" xpfVPN
   where
     tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
     app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
-    cmd _ = proc "nm-applet" [] startProcess
+    cmd _ = proc "nm-applet" [] (startProcess . setCreateGroup True)
 
 runToggleBluetooth :: Maybe SysClient -> SometimesX
 runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index 2af7922..9ae61de 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -93,7 +93,7 @@ runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
   where
     tree = And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock")
       $ Only_ $ IOSometimes_ runScreenLock
-    cmd = proc "xss-lock" ["--ignore-sleep", "screenlock"] startProcess
+    cmd = proc "xss-lock" ["--ignore-sleep", "screenlock"] (startProcess . setCreateGroup True)
 
 --------------------------------------------------------------------------------
 -- | Confirmation prompts

From f3b0fb6ec51355924755c8cf62ab140559a563b9 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Wed, 28 Dec 2022 14:18:39 -0500
Subject: [PATCH 014/118] FIX properly kill processes after xmonad has started

---
 bin/xmonad.hs | 54 ++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 41 insertions(+), 13 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 2c8eb31..4ae5786 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -28,7 +28,11 @@ import qualified RIO.Text                                       as T
 
 import           System.Environment
 import           System.Posix.Signals
-import           System.Process                                 (getPid)
+import           System.Process
+    ( getPid
+    , getProcessExitCode
+    )
+import           System.Process.Typed                           (nullStream)
 
 import           XMonad
 import           XMonad.Actions.CopyWindow
@@ -189,9 +193,13 @@ features cl = FeatureSet
 
 startXmobar :: FIO (Process Handle () ())
 startXmobar = do
-  p <- proc "xmobar" [] (startProcess . setStdin createPipe . setCreateGroup True)
+  p <- proc "xmobar" [] start
   io $ hSetBuffering (getStdin p) LineBuffering
   return p
+  where
+    start = startProcess
+      . setStdin createPipe
+      . setCreateGroup True
 
 startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
@@ -208,14 +216,14 @@ withChildDaemons fs = bracket (startChildDaemons fs) cleanup
   where
     cleanup ps = do
       logInfo "stopping child processes"
-      mapM_ stopProcess ps
+      mapM_ (io . killNoWait) ps
 
 withXmobar :: (Process Handle () () -> FIO a) -> FIO a
 withXmobar = bracket startXmobar cleanup
   where
     cleanup p = do
       logInfo "stopping xmobar child process"
-      stopProcess p
+      io $ killNoWait p
 
 printDeps :: FIO ()
 printDeps = do
@@ -256,15 +264,35 @@ data ThreadState = ThreadState
 runCleanup :: ThreadState -> DBusState -> X ()
 runCleanup ts db = io $ do
   mapM_ killNoWait $ tsXmobar ts
-  finally (mapM_ killNoWait $ tsChildPIDs ts) $
-    disconnectDBusX db
-  where
-    stopNoWait p = handleIO (\_ -> return ()) $ stopProcess p
-    killNoWait p = do
-      let ph = unsafeProcessHandle p
-      i <- getPid ph
-      forM_ i $ signalProcessGroup sigTERM
-      stopNoWait p
+  mapM_ killNoWait $ tsChildPIDs ts
+  disconnectDBusX db
+
+-- | Kill a process (group) after xmonad has already started
+-- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad
+-- sets the handler for sigCHLD to Ignore which breaks 'waitForProcess' (which
+-- in turn will break 'stopProcess') and b) because I want to kill off entire
+-- process groups since they may spawn child processes themselves. NOTE:
+-- for reasons unknown I cannot just turn off/on the signal handlers here.
+killNoWait :: Process a () () -> IO ()
+killNoWait p = do
+  -- this strategy is outlined/sanctioned in RIO.Process under
+  -- 'unsafeProcessHandle':
+  --
+  -- get the handle (unsafely, since it breaks the semantics of RIO)
+  let ph = unsafeProcessHandle p
+  -- check if the process has already exited (if so, do nothing since trying
+  -- to kill it will open wormholes
+  ec <- getProcessExitCode ph
+  unless (isJust ec) $ do
+    -- send SIGTERM to the entire group (NOTE: 'System.Process.terminateProcess'
+    -- does not actually do this despite what the docs say)
+    i <- getPid ph
+    forM_ i $ signalProcessGroup sigTERM
+    -- actually call 'stopProcess' which will clean up associated data and
+    -- then try to wait for the exit, which will fail because we are assuming
+    -- this function is called when the handler for SIGCHLD is Ignore. Ignore
+    -- the failure and move on with life.
+    handleIO (\_ -> return ()) $ stopProcess p
 
 --------------------------------------------------------------------------------
 -- | Startuphook configuration

From e3e89c275435c9d3d720c7384affb35f441eb4fd Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Wed, 28 Dec 2022 16:22:09 -0500
Subject: [PATCH 015/118] ENH use rio for dyn workspace monitor

---
 bin/xmonad.hs                                 |  1 -
 .../Internal/Concurrent/DynamicWorkspaces.hs  | 78 +++++++++----------
 2 files changed, 38 insertions(+), 41 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 4ae5786..c1f9b1a 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -32,7 +32,6 @@ import           System.Process
     ( getPid
     , getProcessExitCode
     )
-import           System.Process.Typed                           (nullStream)
 
 import           XMonad
 import           XMonad.Actions.CopyWindow
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index b27d90b..8cb33f9 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
 --------------------------------------------------------------------------------
 -- | Automatically Manage Dynamic Workspaces
 -- This is a somewhat convoluted wrapper for the Dymamic Workspaces module
@@ -39,10 +37,16 @@ import           Data.List                                (deleteBy, find)
 import qualified Data.Map                                 as M
 import           Data.Maybe
 
-import           Control.Concurrent
+-- import           Control.Concurrent
 import           Control.Monad
 import           Control.Monad.Reader
 
+import           RIO                                      hiding
+    ( Display
+    , display
+    )
+import qualified RIO.Set                                  as S
+
 import           Graphics.X11.Types
 
 import           Graphics.X11.Xlib.Atom
@@ -91,68 +95,62 @@ data DynWorkspace = DynWorkspace
 -- the same as that in XMonad itself (eg with Query types)
 -- type MatchTags = M.Map String String
 
-type WatchedPIDs = MVar [Pid]
-
 data WConf = WConf
     { display       :: Display
     , dynWorkspaces :: [DynWorkspace]
+    , curPIDs       :: MVar (S.Set Pid)
     }
 
-newtype W a = W (ReaderT WConf IO a)
-  deriving (Functor, Monad, MonadIO, MonadReader WConf)
+type W a = RIO WConf ()
 
-instance Applicative W where
-  pure = return
-  (<*>) = ap
-
-runW :: WConf -> W a -> IO a
-runW c (W a) = runReaderT a c
+withDisplay :: (Display -> IO a) -> IO a
+withDisplay = bracket (openDisplay "") closeDisplay
 
 runWorkspaceMon :: [DynWorkspace] -> IO ()
-runWorkspaceMon dws = do
-  dpy <- openDisplay ""
+runWorkspaceMon dws = withDisplay $ \dpy -> do
   root <- rootWindow dpy $ defaultScreen dpy
-  curPIDs <- newMVar [] -- TODO this is ugly, use a mutable state monad
   -- listen only for substructure change events (which includes MapNotify)
   allocaSetWindowAttributes $ \a -> do
     set_event_mask a substructureNotifyMask
     changeWindowAttributes dpy root cWEventMask a
-  let c = WConf { display = dpy, dynWorkspaces = dws }
-  _ <- allocaXEvent $ \e ->
-    runW c $ forever $ handle curPIDs =<< io (nextEvent dpy e >> getEvent e)
-  return ()
+  void $ allocaXEvent $ withEvents dpy
+  where
+    withEvents dpy e = do
+      ps <- newMVar S.empty
+      let c = WConf { display = dpy, dynWorkspaces = dws, curPIDs = ps }
+      runRIO c
+        $ forever
+        $ handleEvent =<< io (nextEvent dpy e >> getEvent e)
 
-handle :: WatchedPIDs -> Event -> W ()
+handleEvent :: Event -> W ()
 
 -- | assume this fires at least once when a new window is created (also could
 -- use CreateNotify but that is really noisy)
-handle curPIDs MapNotifyEvent { ev_window = w } = do
+handleEvent MapNotifyEvent { ev_window = w } = do
   dpy <- asks display
   hint <- io $ getClassHint dpy w
   dws <- asks dynWorkspaces
-  let m = M.fromList $ fmap (\DynWorkspace { dwTag = t, dwClass = c } -> (c, t)) dws
-  let tag = M.lookup (resClass hint) m
-  io $ forM_ tag $ \t -> do
-    a <- internAtom dpy "_NET_WM_PID" False
-    pid <- getWindowProperty32 dpy a w
+  let tag = M.lookup (resClass hint)
+            $ M.fromList
+            $ fmap (\DynWorkspace { dwTag = t, dwClass = c } -> (c, t)) dws
+  forM_ tag $ \t -> do
+    a <- io $ internAtom dpy "_NET_WM_PID" False
+    pid <- io $ getWindowProperty32 dpy a w
     case pid of
       -- ASSUMPTION windows will only have one PID at one time
-      Just [p] -> let p' = fromIntegral p
-        in void $ forkIO $ withUniquePid curPIDs p' $ waitAndKill t p'
+      Just [p] -> let p' = fromIntegral p in void $ async $ withUniquePid p' t
       _        -> return ()
 
-handle _ _ = return ()
+handleEvent _ = return ()
 
-waitAndKill :: String -> Pid -> IO ()
-waitAndKill tag pid = waitUntilExit pid >> sendXMsg Workspace tag
-
-withUniquePid :: WatchedPIDs -> Pid -> IO () -> IO ()
-withUniquePid curPIDs pid f = do
-  pids <- readMVar curPIDs
-  unless (pid `elem` pids) $ do
-    modifyMVar_ curPIDs (return . (pid:))
-    f
-    modifyMVar_ curPIDs (return . filter (/=pid))
+withUniquePid :: Pid -> String -> W ()
+withUniquePid pid tag = do
+  ps <- asks curPIDs
+  pids <- readMVar ps
+  io $ unless (pid `elem` pids) $ bracket_
+    (modifyMVar_ ps (return . S.insert pid))
+    (modifyMVar_ ps (return . S.delete pid))
+    $ waitUntilExit pid >> sendXMsg Workspace tag
 
 --------------------------------------------------------------------------------
 -- | Launching apps

From f5ee8882bc137b78a90f159fda3515c39d0cf65e Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Wed, 28 Dec 2022 20:11:06 -0500
Subject: [PATCH 016/118] REF clean up concurrency libs

---
 lib/XMonad/Internal/Concurrent/ACPIEvent.hs   | 31 ++++++++-----------
 .../Internal/Concurrent/ClientMessage.hs      | 19 ++++++++----
 .../Internal/Concurrent/DynamicWorkspaces.hs  | 17 +++++-----
 lib/XMonad/Internal/Concurrent/VirtualBox.hs  |  7 ++---
 package.yaml                                  |  1 +
 5 files changed, 38 insertions(+), 37 deletions(-)

diff --git a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
index 1c9761b..485ecd9 100644
--- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
+++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
@@ -9,18 +9,13 @@ module XMonad.Internal.Concurrent.ACPIEvent
   , runHandleACPI
   ) where
 
-import           Control.Exception
-import           Control.Monad
-
-import           Data.ByteString                          hiding (readFile)
-import           Data.ByteString.Char8                    as C hiding (readFile)
-import           Data.Connection
 import           Data.Internal.Dependency
 
-import           Text.Read                                (readMaybe)
+import           Network.Socket
+import           Network.Socket.ByteString
 
-import           System.IO.Streams                        as S (read)
-import           System.IO.Streams.UnixSocket
+import           RIO
+import qualified RIO.ByteString                           as B
 
 import           XMonad.Core
 import           XMonad.Internal.Command.Power
@@ -64,7 +59,9 @@ parseLine line =
     (_:"LID":"close":_) -> Just LidClose
     _                   -> Nothing
   where
-    splitLine = C.words . C.reverse . C.dropWhile (== '\n') . C.reverse
+    splitLine = B.split space . B.reverse . B.dropWhile (== newline) . B.reverse
+    newline = 10
+    space = 32
 
 -- | Send an ACPIEvent to the X server as a ClientMessage
 sendACPIEvent :: ACPIEvent -> IO ()
@@ -72,20 +69,18 @@ sendACPIEvent = sendXMsg ACPI . show . fromEnum
 
 isDischarging :: IO (Maybe Bool)
 isDischarging = do
-  status <- try $ readFile "/sys/class/power_supply/BAT0/status"
-    :: IO (Either IOException String)
+  status <- tryIO $ B.readFile "/sys/class/power_supply/BAT0/status"
   case status of
     Left _  -> return Nothing
     Right s -> return $ Just (s == "Discharging")
 
 listenACPI :: IO ()
 listenACPI = do
-  Connection { source = s } <- connect acpiPath
-  forever $ readStream s
-  where
-    readStream s = do
-      out <- S.read s
-      mapM_ sendACPIEvent $ parseLine =<< out
+  sock <- socket AF_UNIX Stream defaultProtocol
+  connect sock $ SockAddrUnix acpiPath
+  forever $ do
+    out <- recv sock 1024
+    mapM_ sendACPIEvent $ parseLine out
 
 acpiPath :: FilePath
 acpiPath = "/var/run/acpid.socket"
diff --git a/lib/XMonad/Internal/Concurrent/ClientMessage.hs b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
index f380b3e..d5ee052 100644
--- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs
+++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
@@ -28,6 +28,9 @@ import           Graphics.X11.Xlib.Atom
 import           Graphics.X11.Xlib.Display
 import           Graphics.X11.Xlib.Event
 import           Graphics.X11.Xlib.Extras
+import           Graphics.X11.Xlib.Types
+
+import           RIO                       hiding (Display)
 
 --------------------------------------------------------------------------------
 -- | Data structure for the ClientMessage
@@ -58,13 +61,19 @@ splitXMsg :: (Integral a) => [a] -> (XMsgType, String)
 splitXMsg [] = (Unknown, "")
 splitXMsg (x:xs) = (xtype, tag)
   where
-    xtype = toEnum $ fromInteger $ toInteger x
-    tag = map (chr . fromInteger . toInteger) $ takeWhile (/= 0) xs
+    xtype = toEnum $ fromIntegral x
+    tag = chr . fromIntegral <$> takeWhile (/= 0) xs
+
+withOpenDisplay :: (Display -> IO a) -> IO a
+withOpenDisplay = bracket (openDisplay "") cleanup
+  where
+    cleanup dpy = do
+      flush dpy
+      closeDisplay dpy
 
 -- | Emit a ClientMessage event to the X server with the given type and payloud
 sendXMsg :: XMsgType -> String -> IO ()
-sendXMsg xtype tag = do
-  dpy <- openDisplay ""
+sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
   root <- rootWindow dpy $ defaultScreen dpy
   allocaXEvent $ \e -> do
     setEventType e clientMessage
@@ -84,8 +93,6 @@ sendXMsg xtype tag = do
     -- for more details.
     setClientMessageEvent' e root bITMAP 8 (x:t)
     sendEvent dpy root False substructureNotifyMask e
-  flush dpy
-  closeDisplay dpy
   where
     x = fromIntegral $ fromEnum xtype
     t = fmap (fromIntegral . fromEnum) tag
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index 8cb33f9..b6e8a20 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -41,11 +41,6 @@ import           Data.Maybe
 import           Control.Monad
 import           Control.Monad.Reader
 
-import           RIO                                      hiding
-    ( Display
-    , display
-    )
-import qualified RIO.Set                                  as S
 
 import           Graphics.X11.Types
 
@@ -56,6 +51,12 @@ import           Graphics.X11.Xlib.Extras
 import           Graphics.X11.Xlib.Misc
 import           Graphics.X11.Xlib.Types
 
+import           RIO                                      hiding
+    ( Display
+    , display
+    )
+import qualified RIO.Set                                  as S
+
 import           XMonad.Actions.DynamicWorkspaces
 import           XMonad.Core
     ( ManageHook
@@ -103,11 +104,11 @@ data WConf = WConf
 
 type W a = RIO WConf ()
 
-withDisplay :: (Display -> IO a) -> IO a
-withDisplay = bracket (openDisplay "") closeDisplay
+withOpenDisplay :: (Display -> IO a) -> IO a
+withOpenDisplay = bracket (openDisplay "") closeDisplay
 
 runWorkspaceMon :: [DynWorkspace] -> IO ()
-runWorkspaceMon dws = withDisplay $ \dpy -> do
+runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
   root <- rootWindow dpy $ defaultScreen dpy
   -- listen only for substructure change events (which includes MapNotify)
   allocaSetWindowAttributes $ \a -> do
diff --git a/lib/XMonad/Internal/Concurrent/VirtualBox.hs b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
index dddfb72..7d1f857 100644
--- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs
+++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
@@ -10,18 +10,15 @@ module XMonad.Internal.Concurrent.VirtualBox
   , qual
   ) where
 
-import           Control.Exception
-
 import           Data.Internal.Dependency
 
 import           Text.XML.Light
 
 import           RIO                      hiding (try)
+import           RIO.Directory
 import           RIO.FilePath
 import qualified RIO.Text                 as T
 
-import           System.Directory
-
 import           XMonad.Internal.Shell
 
 vmExists :: T.Text -> IO (Maybe Msg)
@@ -41,7 +38,7 @@ vmInstanceConfig vmName = do
 vmDirectory :: IO (Either String String)
 vmDirectory = do
   p <- vmConfig
-  (s :: Either IOException String) <- try $ readFile p
+  s <- tryIO $ readFile p
   return $ case s of
     (Left _) -> Left "could not read VirtualBox config file"
     (Right x) -> maybe (Left "Could not parse VirtualBox config file") Right
diff --git a/package.yaml b/package.yaml
index cbffa4e..3885185 100644
--- a/package.yaml
+++ b/package.yaml
@@ -42,6 +42,7 @@ dependencies:
   - lifted-base >= 0.2.3.12
   - utf8-string >= 1.0.2
   - typed-process >= 0.2.8.0
+  - network >= 3.1.2.7
 
 library:
   source-dirs: lib/

From 246208e3cf75498790764b7e188e4c720b478c04 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Wed, 28 Dec 2022 20:11:20 -0500
Subject: [PATCH 017/118] REF clean up process

---
 lib/XMonad/Internal/Process.hs | 33 ++++++---------------------------
 1 file changed, 6 insertions(+), 27 deletions(-)

diff --git a/lib/XMonad/Internal/Process.hs b/lib/XMonad/Internal/Process.hs
index 79f3d21..c49235c 100644
--- a/lib/XMonad/Internal/Process.hs
+++ b/lib/XMonad/Internal/Process.hs
@@ -3,7 +3,7 @@
 
 module XMonad.Internal.Process
   ( waitUntilExit
-  , killHandle
+  -- , killHandle
   -- , spawnPipe'
   -- , spawnPipe
   -- , spawnPipeArgs
@@ -21,14 +21,14 @@ import           Control.Exception
 import           Control.Monad
 import           Control.Monad.IO.Class
 
-import           Data.Maybe
+-- import           Data.Maybe
 
 import qualified RIO.Text               as T
 
 import           System.Directory
 import           System.Exit
 import           System.IO
-import           System.Posix.Signals
+-- import           System.Posix.Signals
 import           System.Process
 
 import           XMonad.Core            hiding (spawn)
@@ -42,17 +42,9 @@ import           XMonad.Core            hiding (spawn)
 waitUntilExit :: Show t => t -> IO ()
 waitUntilExit pid = do
   res <- doesDirectoryExist $ "/proc/" ++ show pid
-  when res $ threadDelay 100000 >> waitUntilExit pid
-
-killHandle :: ProcessHandle -> IO ()
-killHandle ph = do
-  ec <- getProcessExitCode ph
-  unless (isJust ec) $ do
-    pid <- getPid ph
-    forM_ pid $ signalProcess sigTERM
-    -- this may fail if the process exits instantly and the handle
-    -- is destroyed by the time we get to this line (I think?)
-    void (try $ waitForProcess ph :: IO (Either IOException ExitCode))
+  when res $ do
+    threadDelay 100000
+    waitUntilExit pid
 
 withDefaultSignalHandlers :: IO a -> IO a
 withDefaultSignalHandlers =
@@ -81,16 +73,3 @@ spawn = io . void . createProcess' . shell'
 
 spawnAt :: MonadIO m => FilePath -> String -> m ()
 spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }
-
--- spawnPipe' :: CreateProcess -> IO (Handle, ProcessHandle)
--- spawnPipe' cp = do
---   -- ASSUME creating a pipe will always succeed in making a Just Handle
---   (Just h, _, _, p) <- createProcess' $ cp { std_in = CreatePipe }
---   hSetBuffering h LineBuffering
---   return (h, p)
-
--- spawnPipe :: String -> IO (Handle, ProcessHandle)
--- spawnPipe = spawnPipe' . shell
-
--- spawnPipeArgs :: FilePath -> [String] -> IO (Handle, ProcessHandle)
--- spawnPipeArgs cmd = spawnPipe' . proc cmd

From 70541ca5b14f513e00a0519850ac378868e1854a Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Thu, 29 Dec 2022 00:06:55 -0500
Subject: [PATCH 018/118] REF get rid of internal proc module

---
 bin/vbox-start.hs                             |  4 +-
 bin/xmobar.hs                                 | 33 ++++----
 lib/XMonad/Internal/Command/DMenu.hs          |  2 +-
 lib/XMonad/Internal/Command/Desktop.hs        |  1 -
 lib/XMonad/Internal/Command/Power.hs          |  2 +-
 .../Internal/Concurrent/DynamicWorkspaces.hs  |  4 +-
 lib/XMonad/Internal/DBus/Screensaver.hs       | 18 +++--
 lib/XMonad/Internal/IO.hs                     | 20 ++++-
 lib/XMonad/Internal/Process.hs                | 76 +++----------------
 lib/XMonad/Internal/Shell.hs                  | 43 ++++++++++-
 10 files changed, 102 insertions(+), 101 deletions(-)

diff --git a/bin/vbox-start.hs b/bin/vbox-start.hs
index 59cc599..cb82926 100644
--- a/bin/vbox-start.hs
+++ b/bin/vbox-start.hs
@@ -29,7 +29,7 @@ import           Text.XML.Light
 import           System.Environment
 
 import           XMonad.Internal.Concurrent.VirtualBox
-import           XMonad.Internal.Process               (waitUntilExit)
+import           XMonad.Internal.IO
 
 main :: IO ()
 main = do
@@ -46,7 +46,7 @@ runAndWait [n] = do
     runID i = do
       vmLaunch i
       p <- vmPID i
-      liftIO $ waitUntilExit p
+      liftIO $ mapM_ waitUntilExit p
     err = logError "Could not get machine ID"
 
 runAndWait _ = liftIO $ putStrLn "Usage: vbox-start VBOXNAME"
diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index e7b4358..4a56132 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -21,11 +21,12 @@ import           Data.List
 import           Data.Maybe
 
 import           RIO                                            hiding (hFlush)
+import qualified RIO.ByteString.Lazy                            as BL
+import           RIO.Process
 import qualified RIO.Text                                       as T
 
 import           System.Environment
 import           System.IO
-import           System.IO.Error
 
 import           Xmobar.Plugins.Bluetooth
 import           Xmobar.Plugins.ClevoKeyboard
@@ -41,7 +42,6 @@ import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Control
 import           XMonad.Internal.DBus.Screensaver               (ssSignalDep)
-import           XMonad.Internal.Process                        hiding (CmdSpec)
 import qualified XMonad.Internal.Theme                          as XT
 import           Xmobar                                         hiding
     ( iconOffset
@@ -221,7 +221,7 @@ getVPN cl = iconDBus_ "VPN status indicator" xpfVPN root $ toAnd_ vpnDep test
   where
     root useIcon tree = DBusRoot_ (const $ vpnCmd useIcon) tree cl
     test = DBusIO $ IOTest_ "Use nmcli to test if VPN is present"
-      networkManagerPkgs $ io vpnPresent
+      networkManagerPkgs vpnPresent
 
 getBt :: Maybe SysClient -> BarFeature
 getBt = xmobarDBus "bluetooth status indicator" xpfBluetooth btDep btCmd
@@ -416,19 +416,22 @@ dateCmd = CmdSpec
 --------------------------------------------------------------------------------
 -- | low-level testing functions
 
-vpnPresent :: IO (Maybe Msg)
-vpnPresent =
-  go <$> tryIOError (readCreateProcessWithExitCode (proc "nmcli" args) "")
+vpnPresent :: FIO (Maybe Msg)
+vpnPresent = do
+  res <- proc "nmcli" args readProcess
+  return $ case res of
+    (ExitSuccess, out, _) | "vpn" `elem` BL.split 10 out -> Nothing
+                          | otherwise -> Just $ Msg LevelError "vpn not found"
+    (ExitFailure c, _, err) -> Just $ Msg LevelError
+                               $ T.concat
+                               ["vpn search exited with code "
+                               , T.pack $ show c
+                               , ": "
+                               , T.decodeUtf8With T.lenientDecode
+                                 $ BL.toStrict err
+                               ]
   where
     args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
-    go (Right (ExitSuccess, out, _))   = if "vpn" `elem` lines out then Nothing
-                                         else Just $ Msg LevelError "vpn not found"
-    go (Right (ExitFailure c, _, err)) = Just $ Msg LevelError
-                                         $ T.concat ["vpn search exited with code "
-                                                    , T.pack $ show c
-                                                    , ": "
-                                                    , T.pack err]
-    go (Left e)                        = Just $ Msg LevelError $ T.pack $ show e
 
 --------------------------------------------------------------------------------
 -- | text font
@@ -503,5 +506,5 @@ fmtSpecs = T.intercalate sep . fmap go
     go CmdSpec { csAlias = a } = T.concat [pSep, a, pSep]
 
 fmtRegions :: BarRegions -> T.Text
-fmtRegions BarRegions { brLeft = l, brCenter = c, brRight = r } = T.concat $
+fmtRegions BarRegions { brLeft = l, brCenter = c, brRight = r } = T.concat
   [fmtSpecs l, T.singleton lSep, fmtSpecs c, T.singleton rSep, fmtSpecs r]
diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index bad578e..48fc501 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -33,12 +33,12 @@ import           System.Directory
     , getXdgDirectory
     )
 import           System.IO
+import           System.Process
 
 import           XMonad.Core                     hiding (spawn)
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Notify
-import           XMonad.Internal.Process
 import           XMonad.Internal.Shell
 import           XMonad.Util.NamedActions
 
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 724606d..e69441d 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -61,7 +61,6 @@ import           XMonad.Actions.Volume
 import           XMonad.Core                 hiding (spawn)
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Notify
-import           XMonad.Internal.Process     hiding (createPipe, proc)
 import           XMonad.Internal.Shell
 import           XMonad.Operations
 
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index 9ae61de..8f69190 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -42,7 +42,7 @@ import qualified RIO.Text                    as T
 import           System.Directory
 import           System.IO.Error
 
-import           XMonad.Core
+import           XMonad.Core                 hiding (spawn)
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme       as XT
 import           XMonad.Prompt
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index b6e8a20..4944611 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -57,6 +57,8 @@ import           RIO                                      hiding
     )
 import qualified RIO.Set                                  as S
 
+import           System.Process
+
 import           XMonad.Actions.DynamicWorkspaces
 import           XMonad.Core
     ( ManageHook
@@ -67,7 +69,7 @@ import           XMonad.Core
     )
 import           XMonad.Hooks.ManageHelpers               (MaybeManageHook)
 import           XMonad.Internal.Concurrent.ClientMessage
-import           XMonad.Internal.Process
+import           XMonad.Internal.IO
 import           XMonad.ManageHook
 import           XMonad.Operations
 import qualified XMonad.StackSet                          as W
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 56dd086..17e18b4 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -23,29 +23,31 @@ import qualified DBus.Introspection          as I
 import           Graphics.X11.XScreenSaver
 import           Graphics.X11.Xlib.Display
 
+import           System.Process
+
 import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Process
+import           XMonad.Internal.Shell
 
 --------------------------------------------------------------------------------
 -- | Low-level functions
 
 type SSState = Bool -- true is enabled
 
-ssExecutable :: String
+ssExecutable :: FilePath
 ssExecutable = "xset"
 
 toggle :: IO SSState
 toggle = do
   st <- query
-  -- TODO figure out how not to do this with shell commands
-  void $ createProcess' $ proc ssExecutable $ "s" : args st
-  -- TODO this assumes the command succeeds
-  return $ not st
-  where
-    args s = if s then ["off", "-dpms"] else ["on", "+dpms"]
+  let args = if st then ["off", "-dpms"] else ["on", "+dpms"]
+  -- this needs to be done with shell commands, because as far as I know there
+  -- are no Haskell bindings for DPMSDisable/Enable (from libxext)
+  rc <- runProcessX (proc ssExecutable $ "s" : args) ""
+  return $ if rc == ExitSuccess then not st else st
 
 query :: IO SSState
 query = do
+  -- TODO bracket the display
   dpy <- openDisplay ""
   xssi <- xScreenSaverQueryInfo dpy
   closeDisplay dpy
diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs
index 7fe81c8..00e212f 100644
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@@ -21,13 +21,17 @@ module XMonad.Internal.IO
   -- , isWritable
   , PermResult(..)
   , getPermissionsSafe
+  , waitUntilExit
   ) where
 
 import           Data.Char
-import           Data.Text        (pack, unpack)
-import           Data.Text.IO     as T (readFile, writeFile)
+import           Data.Text       (pack, unpack)
+import           Data.Text.IO    as T (readFile, writeFile)
+
+import           RIO
+import           RIO.Directory
+import           RIO.FilePath
 
-import           System.Directory
 import           System.IO.Error
 
 --------------------------------------------------------------------------------
@@ -124,3 +128,13 @@ getPermissionsSafe f = do
 
 -- isWritable :: FilePath -> IO (PermResult Bool)
 -- isWritable = fmap (fmap writable) . getPermissionsSafe
+
+-- | Block until a PID has exited.
+-- Use this to control flow based on a process that was not explicitly started
+-- by the Haskell runtime itself, and thus has no data structures to query.
+waitUntilExit :: (Show t, Num t) => t -> IO ()
+waitUntilExit pid = do
+  res <- doesDirectoryExist $ "/proc" </> show pid
+  when res $ do
+    threadDelay 100000
+    waitUntilExit pid
diff --git a/lib/XMonad/Internal/Process.hs b/lib/XMonad/Internal/Process.hs
index c49235c..1e493d6 100644
--- a/lib/XMonad/Internal/Process.hs
+++ b/lib/XMonad/Internal/Process.hs
@@ -1,75 +1,17 @@
 --------------------------------------------------------------------------------
 -- | Functions for managing processes
 
-module XMonad.Internal.Process
-  ( waitUntilExit
-  -- , killHandle
-  -- , spawnPipe'
-  -- , spawnPipe
-  -- , spawnPipeArgs
-  , createProcess'
-  , readCreateProcessWithExitCode'
-  , proc'
-  , shell'
-  , spawn
-  , spawnAt
-  , module System.Process
-  ) where
+module XMonad.Internal.Process where
 
-import           Control.Concurrent
-import           Control.Exception
-import           Control.Monad
-import           Control.Monad.IO.Class
+-- import           Control.Exception
+-- import           Control.Monad
+-- import           Control.Monad.IO.Class
 
--- import           Data.Maybe
+-- import qualified RIO.Text               as T
 
-import qualified RIO.Text               as T
+-- import           System.Exit
+-- import           System.IO
+-- import           System.Process
 
-import           System.Directory
-import           System.Exit
-import           System.IO
--- import           System.Posix.Signals
-import           System.Process
+-- import           XMonad.Core            hiding (spawn)
 
-import           XMonad.Core            hiding (spawn)
-
--- | Block until a PID has exited (in any form)
--- ASSUMPTION on linux PIDs will always increase until they overflow, in which
--- case they will start to recycle. Barring any fork bombs, this code should
--- work because we can reasonably expect that no processes will spawn with the
--- same PID within the delay limit
--- TODO this will not work if the process is a zombie (maybe I care...)
-waitUntilExit :: Show t => t -> IO ()
-waitUntilExit pid = do
-  res <- doesDirectoryExist $ "/proc/" ++ show pid
-  when res $ do
-    threadDelay 100000
-    waitUntilExit pid
-
-withDefaultSignalHandlers :: IO a -> IO a
-withDefaultSignalHandlers =
-  bracket_ uninstallSignalHandlers installSignalHandlers
-
-addGroupSession :: CreateProcess -> CreateProcess
-addGroupSession cp = cp { create_group = True, new_session = True }
-
-createProcess' :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-createProcess' = withDefaultSignalHandlers . createProcess
-
-readCreateProcessWithExitCode' :: CreateProcess -> String
-  -> IO (ExitCode, T.Text, T.Text)
-readCreateProcessWithExitCode' c i = withDefaultSignalHandlers $ do
-  (r, e, p) <- readCreateProcessWithExitCode c i
-  return (r, T.pack e, T.pack p)
-
-shell' :: String -> CreateProcess
-shell' = addGroupSession . shell
-
-proc' :: FilePath -> [String] -> CreateProcess
-proc' cmd args = addGroupSession $ proc cmd args
-
-spawn :: MonadIO m => String -> m ()
-spawn = io . void . createProcess' . shell'
-
-spawnAt :: MonadIO m => FilePath -> String -> m ()
-spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }
diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index 9f3bc5b..2ec2acc 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -6,9 +6,15 @@
 module XMonad.Internal.Shell
   ( fmtCmd
   , spawnCmd
+  , spawn
   , doubleQuote
   , singleQuote
   , skip
+  , runProcessX
+  , spawnAt
+  , proc'
+  , shell'
+  , createProcess'
   , (#!&&)
   , (#!||)
   , (#!|)
@@ -17,13 +23,46 @@ module XMonad.Internal.Shell
 
 import           Control.Monad.IO.Class
 
-import qualified RIO.Text                as T
+import           RIO
+import qualified RIO.Text               as T
 
-import           XMonad.Internal.Process
+import           System.Process
+
+import qualified XMonad.Core            as X
 
 --------------------------------------------------------------------------------
 -- | Opening subshell
 
+withDefaultSignalHandlers :: IO a -> IO a
+withDefaultSignalHandlers =
+  bracket_ X.uninstallSignalHandlers X.installSignalHandlers
+
+addGroupSession :: CreateProcess -> CreateProcess
+addGroupSession cp = cp { create_group = True, new_session = True }
+
+createProcess' :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
+createProcess' = withDefaultSignalHandlers . createProcess
+
+readProcessX :: CreateProcess -> String -> IO (ExitCode, T.Text, T.Text)
+readProcessX c i = withDefaultSignalHandlers $ do
+  (r, e, p) <- readCreateProcessWithExitCode c i
+  return (r, T.pack e, T.pack p)
+
+runProcessX :: CreateProcess -> String -> IO ExitCode
+runProcessX c i = (\(r, _, _) -> r) <$> readProcessX c i
+
+shell' :: String -> CreateProcess
+shell' = addGroupSession . shell
+
+proc' :: FilePath -> [String] -> CreateProcess
+proc' cmd args = addGroupSession $ proc cmd args
+
+spawn :: MonadIO m => String -> m ()
+spawn = liftIO . void . createProcess' . shell'
+
+spawnAt :: MonadIO m => FilePath -> String -> m ()
+spawnAt fp cmd = liftIO $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }
+
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
 spawnCmd cmd args = spawn $ T.unpack $ fmtCmd cmd args
 

From 0a848c4aa79a0e60694eb6448f923857c4d04bf3 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Thu, 29 Dec 2022 12:01:40 -0500
Subject: [PATCH 019/118] WIP use sane process interface for keybound commands

---
 bin/xmonad.hs                           |  2 +-
 lib/Data/Internal/Dependency.hs         |  2 +-
 lib/XMonad/Internal/Command/DMenu.hs    | 11 ++----
 lib/XMonad/Internal/Command/Desktop.hs  | 27 +++++++------
 lib/XMonad/Internal/Command/Power.hs    |  9 ++---
 lib/XMonad/Internal/DBus/Screensaver.hs |  4 +-
 lib/XMonad/Internal/Shell.hs            | 51 +++++++++++++------------
 7 files changed, 50 insertions(+), 56 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index c1f9b1a..316b242 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -55,7 +55,7 @@ import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Control
 import           XMonad.Internal.DBus.Removable
 import           XMonad.Internal.DBus.Screensaver
-import           XMonad.Internal.Shell
+import           XMonad.Internal.Shell                          hiding (proc)
 import qualified XMonad.Internal.Theme                          as XT
 import           XMonad.Layout.MultiToggle
 import           XMonad.Layout.NoBorders
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index 4814dc2..930ce34 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -137,7 +137,7 @@ import           System.Process.Typed   (nullStream)
 
 import           XMonad.Core            (X, io)
 import           XMonad.Internal.IO
-import           XMonad.Internal.Shell
+import           XMonad.Internal.Shell  hiding (proc, runProcess)
 import           XMonad.Internal.Theme
 
 --------------------------------------------------------------------------------
diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index 48fc501..1cec3a2 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -17,8 +17,7 @@ module XMonad.Internal.Command.DMenu
   , runAutorandrMenu
   ) where
 
-import           Control.Monad.Reader
-
+import qualified Data.ByteString.Char8           as BC
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
@@ -26,14 +25,13 @@ import           DBus
 
 import           Graphics.X11.Types
 
+import qualified RIO.ByteString.Lazy             as B
 import qualified RIO.Text                        as T
 
 import           System.Directory
     ( XdgDirectory (..)
     , getXdgDirectory
     )
-import           System.IO
-import           System.Process
 
 import           XMonad.Core                     hiding (spawn)
 import           XMonad.Internal.Command.Desktop
@@ -203,9 +201,8 @@ showKeysDMenu = Subfeature
   }
 
 showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
-showKeys kbs = io $ do
-      (h, _, _, _) <- createProcess' $ (shell' $ T.unpack cmd) { std_in = CreatePipe }
-      forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
+showKeys kbs = io $ spawnStdin i cmd
   where
+    i = B.fromStrict $ BC.pack $ unlines $ showKm kbs
     cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
       ++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index e69441d..8d3befc 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -50,7 +50,7 @@ import           DBus
 
 import           RIO
 import           RIO.FilePath
-import           RIO.Process
+import qualified RIO.Process                 as P
 import qualified RIO.Text                    as T
 
 import           System.Directory
@@ -58,10 +58,10 @@ import           System.Environment
 import           System.Posix.User
 
 import           XMonad.Actions.Volume
-import           XMonad.Core                 hiding (spawn)
+import           XMonad.Core                 as XC
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Notify
-import           XMonad.Internal.Shell
+import           XMonad.Internal.Shell       as S
 import           XMonad.Operations
 
 --------------------------------------------------------------------------------
@@ -134,8 +134,7 @@ runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
   where
     deps = listToAnds (socketExists "tmux" [] socketName)
       $ fmap (sysExe myTermPkgs) [myTerm, "tmux", "bash"]
-    act = spawn
-      $ T.unpack
+    act = S.spawn
       $ fmtCmd "tmux" ["has-session"]
       #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
       #!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
@@ -250,22 +249,22 @@ runNotificationContext =
 -- | System commands
 
 -- this is required for some vpn's to work properly with network-manager
-runNetAppDaemon :: Maybe SysClient -> Sometimes (FIO (Process () () ()))
+runNetAppDaemon :: Maybe SysClient -> Sometimes (FIO (P.Process () () ()))
 runNetAppDaemon cl = Sometimes "network applet" xpfVPN
   [Subfeature (DBusRoot_ cmd tree cl) "NM-applet"]
   where
     tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
     app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
-    cmd _ = proc "nm-applet" [] (startProcess . setCreateGroup True)
+    cmd _ = P.proc "nm-applet" [] (P.startProcess . P.setCreateGroup True)
 
 runToggleBluetooth :: Maybe SysClient -> SometimesX
 runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth
   [Subfeature (DBusRoot_ cmd tree cl) "bluetoothctl"]
   where
     tree = And_ (Only_ $ DBusIO $ sysExe bluetoothPkgs myBluetooth) (Only_ $ Bus [] btBus)
-    cmd _ = spawn
-      $ T.unpack
-      $ T.unwords [T.pack myBluetooth, "show | grep -q \"Powered: no\""]
+    cmd _ = S.spawn
+      $ fmtCmd myBluetooth ["show"]
+      #!| "grep -q \"Powered: no\""
       #!&& "a=on"
       #!|| "a=off"
       #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
@@ -275,11 +274,12 @@ runToggleEthernet :: SometimesX
 runToggleEthernet = Sometimes "ethernet toggle" xpfEthernet
   [Subfeature root "nmcli"]
   where
-    root = IORoot (spawn . T.unpack . cmd) $ And1 (Only readEthernet) $ Only_
+    root = IORoot cmd $ And1 (Only readEthernet) $ Only_
       $ sysExe networkManagerPkgs "nmcli"
     -- TODO make this less noisy
-    cmd iface =
-      T.unwords ["nmcli -g GENERAL.STATE device show", iface, "| grep -q disconnected"]
+    cmd iface = S.spawn
+      $ fmtCmd "nmcli" ["-g", "GENERAL.STATE", "device", "show", iface]
+      #!| "grep -q disconnected"
       #!&& "a=connect"
       #!|| "a=disconnect"
       #!>> fmtCmd "nmcli" ["device", "$a", iface]
@@ -297,7 +297,6 @@ runRecompile = do
   -- assume that the conf directory contains a valid stack project
   confDir <- asks (cfgDir . directories)
   spawnAt confDir
-    $ T.unpack
     $ fmtCmd "stack" ["install"]
     #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
     #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index 8f69190..f9a83b2 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -36,7 +36,7 @@ import           Graphics.X11.Types
 
 import           RIO
 import           RIO.FilePath
-import           RIO.Process
+import qualified RIO.Process                 as P
 import qualified RIO.Text                    as T
 
 import           System.Directory
@@ -88,12 +88,12 @@ runReboot = spawn "systemctl reboot"
 --------------------------------------------------------------------------------
 -- | Autolock
 
-runAutolock :: Sometimes (FIO (Process () () ()))
+runAutolock :: Sometimes (FIO (P.Process () () ()))
 runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
   where
     tree = And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock")
       $ Only_ $ IOSometimes_ runScreenLock
-    cmd = proc "xss-lock" ["--ignore-sleep", "screenlock"] (startProcess . setCreateGroup True)
+    cmd = P.proc "xss-lock" ["--ignore-sleep", "screenlock"] (P.startProcess . P.setCreateGroup True)
 
 --------------------------------------------------------------------------------
 -- | Confirmation prompts
@@ -148,8 +148,7 @@ runOptimusPrompt' fb = do
   where
     switch mode = confirmPrompt' (prompt mode) (cmd mode) fb
     prompt mode = T.concat ["gpu switch to ", mode, "?"]
-    cmd mode = spawn $
-      T.unpack
+    cmd mode = spawn
       $ T.pack myPrimeOffload
       #!&& T.unwords [T.pack myOptimusManager, "--switch", mode, "--no-confirm"]
       #!&& "killall xmonad"
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 17e18b4..81e8bab 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -23,8 +23,6 @@ import qualified DBus.Introspection          as I
 import           Graphics.X11.XScreenSaver
 import           Graphics.X11.Xlib.Display
 
-import           System.Process
-
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Shell
 
@@ -42,7 +40,7 @@ toggle = do
   let args = if st then ["off", "-dpms"] else ["on", "+dpms"]
   -- this needs to be done with shell commands, because as far as I know there
   -- are no Haskell bindings for DPMSDisable/Enable (from libxext)
-  rc <- runProcessX (proc ssExecutable $ "s" : args) ""
+  rc <- runProcess (proc ssExecutable $ "s" : args)
   return $ if rc == ExitSuccess then not st else st
 
 query :: IO SSState
diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index 2ec2acc..c30d1fe 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -7,14 +7,14 @@ module XMonad.Internal.Shell
   ( fmtCmd
   , spawnCmd
   , spawn
+  , spawnAt
+  , spawnStdin
   , doubleQuote
   , singleQuote
   , skip
-  , runProcessX
-  , spawnAt
-  , proc'
-  , shell'
-  , createProcess'
+  , runProcess
+  , proc
+  , shell
   , (#!&&)
   , (#!||)
   , (#!|)
@@ -24,47 +24,48 @@ module XMonad.Internal.Shell
 import           Control.Monad.IO.Class
 
 import           RIO
+import qualified RIO.ByteString.Lazy    as B
 import qualified RIO.Text               as T
 
-import           System.Process
+import qualified System.Process.Typed   as P
 
 import qualified XMonad.Core            as X
 
 --------------------------------------------------------------------------------
 -- | Opening subshell
+-- https://github.com/xmonad/xmonad/issues/113
 
 withDefaultSignalHandlers :: IO a -> IO a
 withDefaultSignalHandlers =
   bracket_ X.uninstallSignalHandlers X.installSignalHandlers
 
-addGroupSession :: CreateProcess -> CreateProcess
-addGroupSession cp = cp { create_group = True, new_session = True }
+addGroupSession :: P.ProcessConfig x y z -> P.ProcessConfig x y z
+addGroupSession = P.setCreateGroup True . P.setNewSession True
 
-createProcess' :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-createProcess' = withDefaultSignalHandlers . createProcess
+-- readProcess :: P.ProcessConfig a b c -> IO (ExitCode, B.ByteString, B.ByteString)
+-- readProcess = withDefaultSignalHandlers . P.readProcess
 
-readProcessX :: CreateProcess -> String -> IO (ExitCode, T.Text, T.Text)
-readProcessX c i = withDefaultSignalHandlers $ do
-  (r, e, p) <- readCreateProcessWithExitCode c i
-  return (r, T.pack e, T.pack p)
+runProcess :: P.ProcessConfig a b c -> IO ExitCode
+runProcess = withDefaultSignalHandlers . P.runProcess
 
-runProcessX :: CreateProcess -> String -> IO ExitCode
-runProcessX c i = (\(r, _, _) -> r) <$> readProcessX c i
+shell :: T.Text -> P.ProcessConfig () () ()
+shell = addGroupSession . P.shell . T.unpack
 
-shell' :: String -> CreateProcess
-shell' = addGroupSession . shell
+proc :: FilePath -> [T.Text] -> P.ProcessConfig () () ()
+proc cmd args = addGroupSession $ P.proc cmd (T.unpack <$> args)
 
-proc' :: FilePath -> [String] -> CreateProcess
-proc' cmd args = addGroupSession $ proc cmd args
+spawn :: MonadIO m => T.Text -> m ()
+spawn = liftIO . void . P.startProcess . shell
 
-spawn :: MonadIO m => String -> m ()
-spawn = liftIO . void . createProcess' . shell'
+spawnAt :: MonadIO m => FilePath -> T.Text -> m ()
+spawnAt fp = liftIO . void . P.startProcess . P.setWorkingDir fp . shell
 
-spawnAt :: MonadIO m => FilePath -> String -> m ()
-spawnAt fp cmd = liftIO $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }
+spawnStdin :: MonadIO m => B.ByteString -> T.Text -> m ()
+spawnStdin i =
+  liftIO . void . P.startProcess . P.setStdin (P.byteStringInput i) . shell
 
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
-spawnCmd cmd args = spawn $ T.unpack $ fmtCmd cmd args
+spawnCmd cmd = spawn . fmtCmd cmd
 
 --------------------------------------------------------------------------------
 -- | Formatting commands

From 6689a535857c39d4d1b463104e66054ce57e0081 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Thu, 29 Dec 2022 12:05:08 -0500
Subject: [PATCH 020/118] FIX signal handlers for forked processes

---
 lib/XMonad/Internal/Shell.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index c30d1fe..cf74715 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -42,12 +42,12 @@ withDefaultSignalHandlers =
 addGroupSession :: P.ProcessConfig x y z -> P.ProcessConfig x y z
 addGroupSession = P.setCreateGroup True . P.setNewSession True
 
--- readProcess :: P.ProcessConfig a b c -> IO (ExitCode, B.ByteString, B.ByteString)
--- readProcess = withDefaultSignalHandlers . P.readProcess
-
 runProcess :: P.ProcessConfig a b c -> IO ExitCode
 runProcess = withDefaultSignalHandlers . P.runProcess
 
+startProcess :: P.ProcessConfig a b c -> IO (P.Process a b c)
+startProcess = withDefaultSignalHandlers . P.startProcess
+
 shell :: T.Text -> P.ProcessConfig () () ()
 shell = addGroupSession . P.shell . T.unpack
 
@@ -55,14 +55,14 @@ proc :: FilePath -> [T.Text] -> P.ProcessConfig () () ()
 proc cmd args = addGroupSession $ P.proc cmd (T.unpack <$> args)
 
 spawn :: MonadIO m => T.Text -> m ()
-spawn = liftIO . void . P.startProcess . shell
+spawn = liftIO . void . startProcess . shell
 
 spawnAt :: MonadIO m => FilePath -> T.Text -> m ()
-spawnAt fp = liftIO . void . P.startProcess . P.setWorkingDir fp . shell
+spawnAt fp = liftIO . void . startProcess . P.setWorkingDir fp . shell
 
 spawnStdin :: MonadIO m => B.ByteString -> T.Text -> m ()
 spawnStdin i =
-  liftIO . void . P.startProcess . P.setStdin (P.byteStringInput i) . shell
+  liftIO . void . startProcess . P.setStdin (P.byteStringInput i) . shell
 
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
 spawnCmd cmd = spawn . fmtCmd cmd

From 964ec02569c833550cffb87fcc1c001b337db329 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Thu, 29 Dec 2022 13:36:26 -0500
Subject: [PATCH 021/118] DOC add lots of notes to my future self

---
 lib/XMonad/Internal/Shell.hs | 56 ++++++++++++++++++++++++++++++++++--
 1 file changed, 53 insertions(+), 3 deletions(-)

diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index cf74715..7d06aa7 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -1,7 +1,57 @@
-{-# LANGUAGE OverloadedStrings #-}
-
---------------------------------------------------------------------------------
 -- | Functions for formatting and spawning shell commands
+--
+-- TLDR: spawning a "command" in xmonad is complicated for weird reasons, and
+-- this solution is the most sane (for me) given the constraints of the xmonad
+-- codebase.
+--
+-- A few facts about xmonad (and window managers in general):
+-- 1) It is single-threaded (since X is single threaded)
+-- 2) Because of (1), it ignores SIGCHLD, which means any subprocess started
+--    by xmonad will instantly be reaped after spawning. This guarantees the
+--    main thread running the WM will never be blocked.
+--
+-- In general, this means that 'System.Process.waitForProcess' (and similar)
+-- will not work since these call wait() on the child process, which will fail
+-- because the child has already been cleared and thus there is nothing on which
+-- to wait. By extension this also means we don't have access to a child's exit
+-- code.
+--
+-- XMonad and contrib use their own method of spawning subprocesses using the
+-- extremely low-level 'System.Process.Posix' API. See the code for
+-- 'XMonad.Core.spawn' or 'XMonad.Util.Run.safeSpawn'. Specifically, the
+-- sequence is (in terms of the low level Linux API):
+-- 1) call fork()
+-- 2) uninstall signal handlers
+-- 3) call setsid()
+-- 4) start new thing with exec()
+--
+-- In practice, I'm guessing the main reason for 2 and 3 is so that child
+-- processes don't inherit the weird SIGCHLD behavior of xmonad itself. The
+-- setsid thing is one way to guarantee that killing the child thread will also
+-- kill its children (if any). Note that this obviously will not block since
+-- we are calling fork() without wait() (which would throw an error anyways).
+--
+-- What if I actually want the exit code?
+--
+-- The best solution (I can come up with), is to use bracket to uninstall
+-- handlers, run process (with wait), and then reinstall handlers. I can use
+-- this with a much higher-level interface which will make things easier. This
+-- obviously means that if the process is running in the main thread, it needs
+-- to be almost instantaneous (since it actually will be blocking). NOTE: I
+-- shouldn't use this to replace the existing functions in xmonad since
+-- 'spawning' a new process in a non-blocking manner with a higher-level API
+-- will produce lots of Haskell objects that need to be cleaned, and it will be
+-- hard (perhaps impossible) to keep track and deal with these after spawning.
+--
+-- This works, albeit with the cost of using almost every process API in Haskell.
+--
+-- Briefly:
+-- 1) 'System.Process.Posix' (where xmonad lives)
+-- 2) 'System.Process' (wraps 1)
+-- 2) 'System.Process.Typed' (wraps 2, which I prefer for getting exit codes)
+-- 3) 'RIO.Process' (wraps 3, which I prefer at the app level)
+
+{-# LANGUAGE OverloadedStrings #-}
 
 module XMonad.Internal.Shell
   ( fmtCmd

From 0b8f79a968ddd6fc421c73fb026635ca1474d5e0 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Thu, 29 Dec 2022 14:49:06 -0500
Subject: [PATCH 022/118] ENH use xmonad functions for spawning processes

---
 lib/XMonad/Internal/Command/DMenu.hs   |  8 ++++----
 lib/XMonad/Internal/Command/Desktop.hs |  9 ++++-----
 lib/XMonad/Internal/Notify.hs          |  6 ++----
 lib/XMonad/Internal/Shell.hs           | 27 ++++++++++----------------
 4 files changed, 20 insertions(+), 30 deletions(-)

diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index 1cec3a2..2d6de6a 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -17,7 +17,6 @@ module XMonad.Internal.Command.DMenu
   , runAutorandrMenu
   ) where
 
-import qualified Data.ByteString.Char8           as BC
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
@@ -25,13 +24,13 @@ import           DBus
 
 import           Graphics.X11.Types
 
-import qualified RIO.ByteString.Lazy             as B
 import qualified RIO.Text                        as T
 
 import           System.Directory
     ( XdgDirectory (..)
     , getXdgDirectory
     )
+import           System.IO
 
 import           XMonad.Core                     hiding (spawn)
 import           XMonad.Internal.Command.Desktop
@@ -201,8 +200,9 @@ showKeysDMenu = Subfeature
   }
 
 showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
-showKeys kbs = io $ spawnStdin i cmd
+showKeys kbs = do
+  h <- spawnPipe cmd
+  io $ hPutStr h $ unlines $ showKm kbs
   where
-    i = B.fromStrict $ BC.pack $ unlines $ showKm kbs
     cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
       ++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 8d3befc..6a4d00c 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -41,8 +41,6 @@ module XMonad.Internal.Command.Desktop
   , networkManagerPkgs
   ) where
 
-import           Control.Monad.IO.Class
-
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
@@ -58,7 +56,7 @@ import           System.Environment
 import           System.Posix.User
 
 import           XMonad.Actions.Volume
-import           XMonad.Core                 as XC
+import           XMonad.Core                 hiding (spawn)
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Notify
 import           XMonad.Internal.Shell       as S
@@ -296,8 +294,9 @@ runRecompile :: X ()
 runRecompile = do
   -- assume that the conf directory contains a valid stack project
   confDir <- asks (cfgDir . directories)
-  spawnAt confDir
-    $ fmtCmd "stack" ["install"]
+  spawn
+    $ fmtCmd "cd" [T.pack confDir]
+    #!&& fmtCmd "stack" ["install"]
     #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
     #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
 
diff --git a/lib/XMonad/Internal/Notify.hs b/lib/XMonad/Internal/Notify.hs
index 91c1c61..f4063f2 100644
--- a/lib/XMonad/Internal/Notify.hs
+++ b/lib/XMonad/Internal/Notify.hs
@@ -18,12 +18,10 @@ module XMonad.Internal.Notify
   , spawnNotify
   ) where
 
-import           Control.Monad.IO.Class
-import           Data.Maybe
-
 import           DBus.Notify
 
-import qualified RIO.Text               as T
+import           RIO
+import qualified RIO.Text              as T
 
 import           XMonad.Internal.Shell
 
diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index 7d06aa7..73f2546 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -57,8 +57,7 @@ module XMonad.Internal.Shell
   ( fmtCmd
   , spawnCmd
   , spawn
-  , spawnAt
-  , spawnStdin
+  , spawnPipe
   , doubleQuote
   , singleQuote
   , skip
@@ -71,15 +70,13 @@ module XMonad.Internal.Shell
   , (#!>>)
   ) where
 
-import           Control.Monad.IO.Class
-
 import           RIO
-import qualified RIO.ByteString.Lazy    as B
-import qualified RIO.Text               as T
+import qualified RIO.Text             as T
 
-import qualified System.Process.Typed   as P
+import qualified System.Process.Typed as P
 
-import qualified XMonad.Core            as X
+import qualified XMonad.Core          as X
+import qualified XMonad.Util.Run      as XR
 
 --------------------------------------------------------------------------------
 -- | Opening subshell
@@ -95,9 +92,6 @@ addGroupSession = P.setCreateGroup True . P.setNewSession True
 runProcess :: P.ProcessConfig a b c -> IO ExitCode
 runProcess = withDefaultSignalHandlers . P.runProcess
 
-startProcess :: P.ProcessConfig a b c -> IO (P.Process a b c)
-startProcess = withDefaultSignalHandlers . P.startProcess
-
 shell :: T.Text -> P.ProcessConfig () () ()
 shell = addGroupSession . P.shell . T.unpack
 
@@ -105,14 +99,13 @@ proc :: FilePath -> [T.Text] -> P.ProcessConfig () () ()
 proc cmd args = addGroupSession $ P.proc cmd (T.unpack <$> args)
 
 spawn :: MonadIO m => T.Text -> m ()
-spawn = liftIO . void . startProcess . shell
+spawn = X.spawn . T.unpack
 
-spawnAt :: MonadIO m => FilePath -> T.Text -> m ()
-spawnAt fp = liftIO . void . startProcess . P.setWorkingDir fp . shell
+-- spawnAt :: MonadIO m => FilePath -> T.Text -> m ()
+-- spawnAt fp = liftIO . void . startProcess . P.setWorkingDir fp . shell
 
-spawnStdin :: MonadIO m => B.ByteString -> T.Text -> m ()
-spawnStdin i =
-  liftIO . void . startProcess . P.setStdin (P.byteStringInput i) . shell
+spawnPipe :: MonadIO m => T.Text -> m Handle
+spawnPipe = XR.spawnPipe . T.unpack
 
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
 spawnCmd cmd = spawn . fmtCmd cmd

From aa3979b36fa756f08a8e43fbe041dfb118eef361 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Thu, 29 Dec 2022 15:04:48 -0500
Subject: [PATCH 023/118] FIX delay in displaying keys

---
 lib/XMonad/Internal/Command/DMenu.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index 2d6de6a..2fb2477 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -203,6 +203,7 @@ showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
 showKeys kbs = do
   h <- spawnPipe cmd
   io $ hPutStr h $ unlines $ showKm kbs
+  io $ hClose h
   where
     cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
       ++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs

From 017d13d80c078ca6ba970c3f6ff46e39c19379c9 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Thu, 29 Dec 2022 15:22:48 -0500
Subject: [PATCH 024/118] ENH clean up docs in shell

---
 lib/XMonad/Internal/Shell.hs | 113 ++++++++++++++++-------------------
 1 file changed, 50 insertions(+), 63 deletions(-)

diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index 73f2546..00264ee 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -1,55 +1,4 @@
 -- | Functions for formatting and spawning shell commands
---
--- TLDR: spawning a "command" in xmonad is complicated for weird reasons, and
--- this solution is the most sane (for me) given the constraints of the xmonad
--- codebase.
---
--- A few facts about xmonad (and window managers in general):
--- 1) It is single-threaded (since X is single threaded)
--- 2) Because of (1), it ignores SIGCHLD, which means any subprocess started
---    by xmonad will instantly be reaped after spawning. This guarantees the
---    main thread running the WM will never be blocked.
---
--- In general, this means that 'System.Process.waitForProcess' (and similar)
--- will not work since these call wait() on the child process, which will fail
--- because the child has already been cleared and thus there is nothing on which
--- to wait. By extension this also means we don't have access to a child's exit
--- code.
---
--- XMonad and contrib use their own method of spawning subprocesses using the
--- extremely low-level 'System.Process.Posix' API. See the code for
--- 'XMonad.Core.spawn' or 'XMonad.Util.Run.safeSpawn'. Specifically, the
--- sequence is (in terms of the low level Linux API):
--- 1) call fork()
--- 2) uninstall signal handlers
--- 3) call setsid()
--- 4) start new thing with exec()
---
--- In practice, I'm guessing the main reason for 2 and 3 is so that child
--- processes don't inherit the weird SIGCHLD behavior of xmonad itself. The
--- setsid thing is one way to guarantee that killing the child thread will also
--- kill its children (if any). Note that this obviously will not block since
--- we are calling fork() without wait() (which would throw an error anyways).
---
--- What if I actually want the exit code?
---
--- The best solution (I can come up with), is to use bracket to uninstall
--- handlers, run process (with wait), and then reinstall handlers. I can use
--- this with a much higher-level interface which will make things easier. This
--- obviously means that if the process is running in the main thread, it needs
--- to be almost instantaneous (since it actually will be blocking). NOTE: I
--- shouldn't use this to replace the existing functions in xmonad since
--- 'spawning' a new process in a non-blocking manner with a higher-level API
--- will produce lots of Haskell objects that need to be cleaned, and it will be
--- hard (perhaps impossible) to keep track and deal with these after spawning.
---
--- This works, albeit with the cost of using almost every process API in Haskell.
---
--- Briefly:
--- 1) 'System.Process.Posix' (where xmonad lives)
--- 2) 'System.Process' (wraps 1)
--- 2) 'System.Process.Typed' (wraps 2, which I prefer for getting exit codes)
--- 3) 'RIO.Process' (wraps 3, which I prefer at the app level)
 
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -78,70 +27,108 @@ import qualified System.Process.Typed as P
 import qualified XMonad.Core          as X
 import qualified XMonad.Util.Run      as XR
 
---------------------------------------------------------------------------------
--- | Opening subshell
--- https://github.com/xmonad/xmonad/issues/113
+-- | Fork a new process and wait for its exit code.
+--
+-- This function will work despite xmonad ignoring SIGCHLD.
+--
+-- A few facts about xmonad (and window managers in general):
+-- 1) It is single-threaded (since X is single threaded)
+-- 2) Because of (1), it ignores SIGCHLD, which means any subprocess started
+--    by xmonad will instantly be reaped after spawning. This guarantees the
+--    main thread running the WM will never be blocked.
+--
+-- In general, this means I can't wait for exit codes (since wait() doesn't
+-- work) See https://github.com/xmonad/xmonad/issues/113.
+--
+-- If I want an exit code, The best solution (I can come up with), is to use
+-- bracket to uninstall handlers, run process (with wait), and then reinstall
+-- handlers. I can use this with a much higher-level interface which will make
+-- things easier. This obviously means that if the process is running in the
+-- main thread, it needs to be almost instantaneous. Note if using a high-level
+-- API for this, the process needs to spawn, finish, and be reaped by the
+-- xmonad process all while the signal handlers are 'disabled' (which limits
+-- the functions I can use to those that call waitForProcess).
+--
+-- XMonad and contrib use their own method of spawning subprocesses using the
+-- extremely low-level 'System.Process.Posix' API. See the code for
+-- 'XMonad.Core.spawn' or 'XMonad.Util.Run.safeSpawn'. Specifically, the
+-- sequence is (in terms of the low level Linux API):
+-- 1) call fork()
+-- 2) uninstall signal handlers (to allow wait() to work in subprocesses)
+-- 3) call setsid() (so killing the child will kill its children, if any)
+-- 4) start new thing with exec()
+--
+-- In contrast with high-level APIs like 'System.Process', this will leave no
+-- trailing data structures to clean up, at the cost of being gross to look at
+-- and possibly more error-prone.
+runProcess :: P.ProcessConfig a b c -> IO ExitCode
+runProcess = withDefaultSignalHandlers . P.runProcess
 
+-- | Run an action without xmonad's signal handlers.
 withDefaultSignalHandlers :: IO a -> IO a
 withDefaultSignalHandlers =
   bracket_ X.uninstallSignalHandlers X.installSignalHandlers
 
+-- | Set a child process to create a new group and session
 addGroupSession :: P.ProcessConfig x y z -> P.ProcessConfig x y z
 addGroupSession = P.setCreateGroup True . P.setNewSession True
 
-runProcess :: P.ProcessConfig a b c -> IO ExitCode
-runProcess = withDefaultSignalHandlers . P.runProcess
-
+-- | Create a 'ProcessConfig' for a shell command
 shell :: T.Text -> P.ProcessConfig () () ()
 shell = addGroupSession . P.shell . T.unpack
 
+-- | Create a 'ProcessConfig' for a command with arguments
 proc :: FilePath -> [T.Text] -> P.ProcessConfig () () ()
 proc cmd args = addGroupSession $ P.proc cmd (T.unpack <$> args)
 
+-- | Run 'XMonad.Core.spawn' with 'Text' input.
 spawn :: MonadIO m => T.Text -> m ()
 spawn = X.spawn . T.unpack
 
--- spawnAt :: MonadIO m => FilePath -> T.Text -> m ()
--- spawnAt fp = liftIO . void . startProcess . P.setWorkingDir fp . shell
-
+-- | Run 'XMonad.Run.Utils.spawnPipe' with 'Text' input.
 spawnPipe :: MonadIO m => T.Text -> m Handle
 spawnPipe = XR.spawnPipe . T.unpack
 
+-- | Run 'XMonad.Core.spawn' with a command and arguments
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
 spawnCmd cmd = spawn . fmtCmd cmd
 
---------------------------------------------------------------------------------
--- | Formatting commands
-
+-- | Format a command and list of arguments as 'Text'
 fmtCmd :: FilePath -> [T.Text] -> T.Text
 fmtCmd cmd args = T.unwords $ T.pack cmd : args
 
 op :: T.Text -> T.Text -> T.Text -> T.Text
 op a x b = T.unwords [a, x, b]
 
+-- | Format two shell expressions separated by "&&"
 (#!&&) :: T.Text -> T.Text -> T.Text
 cmdA #!&& cmdB = op cmdA "&&" cmdB
 
 infixr 0 #!&&
 
+-- | Format two shell expressions separated by "|"
 (#!|) :: T.Text -> T.Text -> T.Text
 cmdA #!| cmdB = op cmdA "|" cmdB
 
 infixr 0 #!|
 
+-- | Format two shell expressions separated by "||"
 (#!||) :: T.Text -> T.Text -> T.Text
 cmdA #!|| cmdB = op cmdA "||" cmdB
 
 infixr 0 #!||
 
+-- | Format two shell expressions separated by ";"
 (#!>>) :: T.Text -> T.Text -> T.Text
 cmdA #!>> cmdB = op cmdA ";" cmdB
 
 infixr 0 #!>>
 
+-- | Wrap input in double quotes
 doubleQuote :: T.Text -> T.Text
 doubleQuote s = T.concat ["\"", s, "\""]
 
+-- | Wrap input in single quotes
 singleQuote :: T.Text -> T.Text
 singleQuote s = T.concat ["'", s, "'"]
 

From 769df2fb002f2e78d79e680aca8bbff4faf232bf Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 10:38:21 -0500
Subject: [PATCH 025/118] WIP use unliftio everywhere-ish

---
 bin/xmobar.hs                                 |  23 +--
 bin/xmonad.hs                                 |   9 +-
 lib/Data/Internal/DBus.hs                     | 144 ++++++++++++------
 lib/Data/Internal/Dependency.hs               |  31 ++--
 lib/XMonad/Internal/Command/DMenu.hs          |   5 +-
 lib/XMonad/Internal/Command/Desktop.hs        |   2 +-
 lib/XMonad/Internal/Command/Power.hs          |   6 +-
 .../Internal/Concurrent/ClientMessage.hs      |   1 +
 .../Internal/Concurrent/DynamicWorkspaces.hs  |  15 +-
 lib/XMonad/Internal/Concurrent/VirtualBox.hs  |   4 +-
 .../Internal/DBus/Brightness/ClevoKeyboard.hs |   4 +-
 lib/XMonad/Internal/DBus/Brightness/Common.hs |   4 +-
 .../DBus/Brightness/IntelBacklight.hs         |   2 +-
 lib/XMonad/Internal/DBus/Control.hs           |  53 ++++---
 lib/XMonad/Internal/DBus/Removable.hs         |   8 +-
 lib/XMonad/Internal/DBus/Screensaver.hs       |  13 +-
 lib/XMonad/Internal/IO.hs                     |   7 +-
 lib/XMonad/Internal/Process.hs                |  17 ---
 lib/Xmobar/Plugins/BacklightCommon.hs         |   9 +-
 lib/Xmobar/Plugins/Bluetooth.hs               |  96 ++++++------
 lib/Xmobar/Plugins/ClevoKeyboard.hs           |   1 -
 lib/Xmobar/Plugins/Common.hs                  |  35 +++--
 lib/Xmobar/Plugins/Device.hs                  |   8 +-
 lib/Xmobar/Plugins/IntelBacklight.hs          |   1 -
 lib/Xmobar/Plugins/Screensaver.hs             |   9 +-
 lib/Xmobar/Plugins/VPN.hs                     |  30 ++--
 26 files changed, 282 insertions(+), 255 deletions(-)
 delete mode 100644 lib/XMonad/Internal/Process.hs

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 4a56132..4f2e496 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -56,17 +56,20 @@ main = getArgs >>= parse
 parse :: [String] -> IO ()
 parse []         = run
 parse ["--deps"] = withCache printDeps
-parse ["--test"] = void $ withCache . evalConfig =<< connectDBus
+parse ["--test"] = withCache $ do
+  db <- connectDBus
+  void $ evalConfig db
 parse _          = usage
 
 run :: IO ()
-run = do
-  db <- connectDBus
-  c <- withCache $ evalConfig db
-  disconnectDBus db
-  -- this is needed to see any printed messages
-  hFlush stdout
-  xmobar c
+run =
+  withCache $ do
+    db <- connectDBus
+    c <- evalConfig db
+    disconnectDBus db
+    -- this is needed to see any printed messages
+    liftIO $ hFlush stdout
+    liftIO $ xmobar c
 
 evalConfig :: DBusState -> FIO Config
 evalConfig db = do
@@ -78,10 +81,10 @@ evalConfig db = do
 
 printDeps :: FIO ()
 printDeps = do
-  db <- io connectDBus
+  db <- connectDBus
   let ps = sort $ nub $ fmap showFulfillment $ concatMap dumpFeature $ allFeatures db
   io $ mapM_ (putStrLn . T.unpack) ps
-  io $ disconnectDBus db
+  disconnectDBus db
 
 usage :: IO ()
 usage = putStrLn $ intercalate "\n"
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 316b242..75ed5c4 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -8,12 +8,8 @@
 
 module Main (main) where
 
-import           Control.Monad
-
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
-import           Data.List
-import           Data.Maybe
 import           Data.Monoid
 import           Data.Text.IO                                   (hPutStrLn)
 
@@ -23,6 +19,7 @@ import           Graphics.X11.Xlib.Extras
 
 import           RIO
 import           RIO.Directory
+import           RIO.List
 import           RIO.Process
 import qualified RIO.Text                                       as T
 
@@ -204,7 +201,7 @@ startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
 
 withDBusX :: (DBusState -> FIO a) -> FIO a
-withDBusX = bracket (io connectDBusX) cleanup
+withDBusX = bracket connectDBusX cleanup
   where
     cleanup db = do
       logInfo "unregistering xmonad from DBus"
@@ -226,7 +223,7 @@ withXmobar = bracket startXmobar cleanup
 
 printDeps :: FIO ()
 printDeps = do
-  db <- io connectDBus
+  db <- connectDBus
   (i, f, d) <- allFeatures db
   io $ mapM_ (putStrLn . T.unpack)
     $ fmap showFulfillment
diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 0bfe459..94a8c8f 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -27,14 +27,9 @@ module Data.Internal.DBus
   , bodyToMaybe
   ) where
 
-import           Control.Exception
-import           Control.Monad
-
-import           Data.Bifunctor
-import qualified Data.Map.Strict   as M
-import           Data.Maybe
-
-import qualified RIO.Text          as T
+import           RIO
+import qualified RIO.Map     as M
+import qualified RIO.Text    as T
 
 import           DBus
 import           DBus.Client
@@ -45,23 +40,38 @@ import           DBus.Client
 class SafeClient c where
   toClient :: c -> Client
 
-  getDBusClient :: IO (Maybe c)
+  getDBusClient
+    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
+    => m (Maybe c)
 
-  disconnectDBusClient :: c -> IO ()
-  disconnectDBusClient = disconnect . toClient
+  disconnectDBusClient
+    :: (MonadUnliftIO m)
+    => c
+    -> m ()
+  disconnectDBusClient = liftIO . disconnect . toClient
 
-  withDBusClient :: (c -> IO a) -> IO (Maybe a)
+  withDBusClient
+    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
+    => (c -> m a)
+    -> m (Maybe a)
+  -- TODO bracket
   withDBusClient f = do
     client <- getDBusClient
     forM client $ \c -> do
       r <- f c
-      disconnect (toClient c)
+      liftIO $ disconnect (toClient c)
       return r
 
-  withDBusClient_ :: (c -> IO ()) -> IO ()
+  withDBusClient_
+    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
+    => (c -> m ())
+    -> m ()
   withDBusClient_ = void . withDBusClient
 
-  fromDBusClient :: (c -> a) -> IO (Maybe a)
+  fromDBusClient
+    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
+    => (c -> a)
+    -> m (Maybe a)
   fromDBusClient f = withDBusClient (return . f)
 
 newtype SysClient = SysClient Client
@@ -69,20 +79,25 @@ newtype SysClient = SysClient Client
 instance SafeClient SysClient where
   toClient (SysClient cl) = cl
 
-  getDBusClient = fmap SysClient <$> getDBusClient' True
+  getDBusClient = fmap SysClient <$> getDBusClient_ True
 
 newtype SesClient = SesClient Client
 
 instance SafeClient SesClient where
   toClient (SesClient cl) = cl
 
-  getDBusClient = fmap SesClient <$> getDBusClient' False
+  getDBusClient = fmap SesClient <$> getDBusClient_ False
 
-getDBusClient' :: Bool -> IO (Maybe Client)
-getDBusClient' sys = do
-  res <- try $ if sys then connectSystem else connectSession
+getDBusClient_
+  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
+  => Bool
+  -> m (Maybe Client)
+getDBusClient_ sys = do
+  res <- try $ liftIO $ if sys then connectSystem else connectSession
   case res of
-    Left e  -> putStrLn (clientErrorMessage e) >> return Nothing
+    Left e  -> do
+      logError $ Utf8Builder $ encodeUtf8Builder $ T.pack $ clientErrorMessage e
+      return Nothing
     Right c -> return $ Just c
 
 --------------------------------------------------------------------------------
@@ -90,12 +105,14 @@ getDBusClient' sys = do
 
 type MethodBody = Either T.Text [Variant]
 
-callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody
-callMethod' cl = fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
+callMethod' :: (MonadIO m, SafeClient c) => c -> MethodCall -> m MethodBody
+callMethod' cl =
+  liftIO
+  . fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
   . call (toClient cl)
 
-callMethod :: SafeClient c => c -> BusName -> ObjectPath -> InterfaceName
-  -> MemberName -> IO MethodBody
+callMethod :: (MonadIO m, SafeClient c) => c -> BusName -> ObjectPath -> InterfaceName
+  -> MemberName -> m MethodBody
 callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
 
 methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
@@ -108,7 +125,7 @@ methodCallBus b p i m = (methodCall p i m)
 dbusInterface :: InterfaceName
 dbusInterface = interfaceName_ "org.freedesktop.DBus"
 
-callGetNameOwner :: SafeClient c => c -> BusName -> IO (Maybe BusName)
+callGetNameOwner :: (MonadIO m, SafeClient c) => c -> BusName -> m (Maybe BusName)
 callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
   where
     mc = (methodCallBus dbusName dbusPath dbusInterface mem)
@@ -129,9 +146,14 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant
 
 type SignalCallback = [Variant] -> IO ()
 
-addMatchCallback :: SafeClient c => MatchRule -> SignalCallback -> c
-  -> IO SignalHandler
-addMatchCallback rule cb cl = addMatch (toClient cl) rule $ cb . signalBody
+addMatchCallback
+  :: (MonadIO m, SafeClient c)
+  => MatchRule
+  -> SignalCallback
+  -> c
+  -> m SignalHandler
+addMatchCallback rule cb cl =
+  liftIO $ addMatch (toClient cl) rule $ cb . signalBody
 
 matchSignal :: Maybe BusName -> Maybe ObjectPath -> Maybe InterfaceName
   -> Maybe MemberName -> MatchRule
@@ -142,8 +164,14 @@ matchSignal b p i m = matchAny
   , matchMember = m
   }
 
-matchSignalFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
-  -> Maybe InterfaceName -> Maybe MemberName -> IO (Maybe MatchRule)
+matchSignalFull
+  :: (MonadIO m, SafeClient c)
+  => c
+  -> BusName
+  -> Maybe ObjectPath
+  -> Maybe InterfaceName
+  -> Maybe MemberName
+  -> m (Maybe MatchRule)
 matchSignalFull client b p i m =
   fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
 
@@ -156,23 +184,29 @@ propertyInterface = interfaceName_ "org.freedesktop.DBus.Properties"
 propertySignal :: MemberName
 propertySignal = memberName_ "PropertiesChanged"
 
-callPropertyGet :: SafeClient c => BusName -> ObjectPath -> InterfaceName
-  -> MemberName -> c -> IO [Variant]
-callPropertyGet bus path iface property cl = fmap (either (const []) (:[]))
+callPropertyGet :: (MonadIO m, SafeClient c) => BusName -> ObjectPath -> InterfaceName
+  -> MemberName -> c -> m [Variant]
+callPropertyGet bus path iface property cl =
+  liftIO
+  $ fmap (either (const []) (:[]))
   $ getProperty (toClient cl) $ methodCallBus bus path iface property
 
 matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
 matchProperty b p =
   matchSignal b p (Just propertyInterface) (Just propertySignal)
 
-matchPropertyFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
-  -> IO (Maybe MatchRule)
+matchPropertyFull
+  :: (MonadIO m, SafeClient c)
+  => c
+  -> BusName
+  -> Maybe ObjectPath
+  -> m (Maybe MatchRule)
 matchPropertyFull cl b p =
   matchSignalFull cl b p (Just propertyInterface) (Just propertySignal)
 
 data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show)
 
-withSignalMatch :: (Maybe a -> IO ()) -> SignalMatch a -> IO ()
+withSignalMatch :: Monad m => (Maybe a -> m ()) -> SignalMatch a -> m ()
 withSignalMatch f (Match x) = f (Just x)
 withSignalMatch f Failure   = f Nothing
 withSignalMatch _ NoMatch   = return ()
@@ -208,24 +242,44 @@ omInterfacesAdded = memberName_ "InterfacesAdded"
 omInterfacesRemoved :: MemberName
 omInterfacesRemoved = memberName_ "InterfacesRemoved"
 
-callGetManagedObjects :: SafeClient c => c -> BusName -> ObjectPath
-  -> IO ObjectTree
+callGetManagedObjects
+  :: (MonadIO m, SafeClient c)
+  => c
+  -> BusName
+  -> ObjectPath
+  -> m ObjectTree
 callGetManagedObjects cl bus path =
   either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
   <$> callMethod cl bus path omInterface getManagedObjects
 
-addInterfaceChangedListener :: SafeClient c => BusName -> MemberName
-  -> ObjectPath -> SignalCallback -> c -> IO (Maybe SignalHandler)
+addInterfaceChangedListener
+  :: (MonadIO m, SafeClient c)
+  => BusName
+  -> MemberName
+  -> ObjectPath
+  -> SignalCallback
+  -> c
+  -> m (Maybe SignalHandler)
 addInterfaceChangedListener bus prop path sc cl = do
   rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
   forM rule $ \r -> addMatchCallback r sc cl
 
-addInterfaceAddedListener :: SafeClient c => BusName -> ObjectPath
-  -> SignalCallback -> c -> IO (Maybe SignalHandler)
+addInterfaceAddedListener
+  :: (MonadIO m, SafeClient c)
+  => BusName
+  -> ObjectPath
+  -> SignalCallback
+  -> c
+  -> m (Maybe SignalHandler)
 addInterfaceAddedListener bus =
   addInterfaceChangedListener bus omInterfacesAdded
 
-addInterfaceRemovedListener :: SafeClient c => BusName -> ObjectPath
-  -> SignalCallback -> c -> IO (Maybe SignalHandler)
+addInterfaceRemovedListener
+  :: (MonadIO m, SafeClient c)
+  => BusName
+  -> ObjectPath
+  -> SignalCallback
+  -> c
+  -> m (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
   addInterfaceChangedListener bus omInterfacesRemoved
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index 930ce34..6a23520 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -106,38 +106,31 @@ module Data.Internal.Dependency
   , shellTest
   ) where
 
-import           Control.Monad.IO.Class
-import           Control.Monad.Identity
-import           Control.Monad.Reader
-
-import           Data.Aeson             hiding (Error, Result)
+import           Data.Aeson            hiding (Error, Result)
 import           Data.Aeson.Key
-import           Data.Bifunctor
-import           Data.Either
 import           Data.Internal.DBus
-import           Data.List
-import           Data.Maybe
 import           Data.Yaml
 
-import           GHC.IO.Exception       (ioe_description)
+import           GHC.IO.Exception      (ioe_description)
 
-import           DBus                   hiding (typeOf)
-import qualified DBus.Introspection     as I
+import           DBus                  hiding (typeOf)
+import qualified DBus.Introspection    as I
 
-import           RIO                    hiding (bracket, fromString)
+import           RIO                   hiding (bracket, fromString)
+import           RIO.Directory
 import           RIO.FilePath
-import           RIO.Process            hiding (findExecutable)
-import qualified RIO.Text               as T
+import           RIO.List
+import           RIO.Process           hiding (findExecutable)
+import qualified RIO.Text              as T
 
-import           System.Directory
 import           System.Environment
 import           System.IO.Error
 import           System.Posix.Files
-import           System.Process.Typed   (nullStream)
+import           System.Process.Typed  (nullStream)
 
-import           XMonad.Core            (X, io)
+import           XMonad.Core           (X, io)
 import           XMonad.Internal.IO
-import           XMonad.Internal.Shell  hiding (proc, runProcess)
+import           XMonad.Internal.Shell hiding (proc, runProcess)
 import           XMonad.Internal.Theme
 
 --------------------------------------------------------------------------------
diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index 2fb2477..5d69630 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -24,12 +24,9 @@ import           DBus
 
 import           Graphics.X11.Types
 
+import           RIO.Directory
 import qualified RIO.Text                        as T
 
-import           System.Directory
-    ( XdgDirectory (..)
-    , getXdgDirectory
-    )
 import           System.IO
 
 import           XMonad.Core                     hiding (spawn)
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 6a4d00c..509bca0 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -47,11 +47,11 @@ import           Data.Internal.Dependency
 import           DBus
 
 import           RIO
+import           RIO.Directory
 import           RIO.FilePath
 import qualified RIO.Process                 as P
 import qualified RIO.Text                    as T
 
-import           System.Directory
 import           System.Environment
 import           System.Posix.User
 
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index f9a83b2..f376aa5 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -29,17 +29,15 @@ module XMonad.Internal.Command.Power
 
 import           Data.Internal.Dependency
 
-import           Data.Either
-import qualified Data.Map                    as M
-
 import           Graphics.X11.Types
 
 import           RIO
+import           RIO.Directory
 import           RIO.FilePath
+import qualified RIO.Map                     as M
 import qualified RIO.Process                 as P
 import qualified RIO.Text                    as T
 
-import           System.Directory
 import           System.IO.Error
 
 import           XMonad.Core                 hiding (spawn)
diff --git a/lib/XMonad/Internal/Concurrent/ClientMessage.hs b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
index d5ee052..deda5a8 100644
--- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs
+++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
@@ -19,6 +19,7 @@ module XMonad.Internal.Concurrent.ClientMessage
   ( XMsgType(..)
   , sendXMsg
   , splitXMsg
+  , withOpenDisplay
   ) where
 
 import           Data.Char
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index 4944611..3a43626 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -33,17 +33,7 @@ module XMonad.Internal.Concurrent.DynamicWorkspaces
   , doSink
   ) where
 
-import           Data.List                                (deleteBy, find)
-import qualified Data.Map                                 as M
-import           Data.Maybe
-
--- import           Control.Concurrent
-import           Control.Monad
-import           Control.Monad.Reader
-
-
 import           Graphics.X11.Types
-
 import           Graphics.X11.Xlib.Atom
 import           Graphics.X11.Xlib.Display
 import           Graphics.X11.Xlib.Event
@@ -55,6 +45,8 @@ import           RIO                                      hiding
     ( Display
     , display
     )
+import           RIO.List
+import qualified RIO.Map                                  as M
 import qualified RIO.Set                                  as S
 
 import           System.Process
@@ -106,9 +98,6 @@ data WConf = WConf
 
 type W a = RIO WConf ()
 
-withOpenDisplay :: (Display -> IO a) -> IO a
-withOpenDisplay = bracket (openDisplay "") closeDisplay
-
 runWorkspaceMon :: [DynWorkspace] -> IO ()
 runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
   root <- rootWindow dpy $ defaultScreen dpy
diff --git a/lib/XMonad/Internal/Concurrent/VirtualBox.hs b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
index 7d1f857..2695e74 100644
--- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs
+++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
@@ -12,13 +12,13 @@ module XMonad.Internal.Concurrent.VirtualBox
 
 import           Data.Internal.Dependency
 
-import           Text.XML.Light
-
 import           RIO                      hiding (try)
 import           RIO.Directory
 import           RIO.FilePath
 import qualified RIO.Text                 as T
 
+import           Text.XML.Light
+
 import           XMonad.Internal.Shell
 
 vmExists :: T.Text -> IO (Maybe Msg)
diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
index 3395f4b..1ce79f8 100644
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@@ -12,14 +12,12 @@ module XMonad.Internal.DBus.Brightness.ClevoKeyboard
   , blPath
   ) where
 
-import           Control.Monad                          (when)
-
-import           Data.Int                               (Int32)
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
 import           DBus
 
+import           RIO
 import           RIO.FilePath
 
 import           XMonad.Internal.DBus.Brightness.Common
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 8146055..05e6313 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -13,9 +13,6 @@ module XMonad.Internal.DBus.Brightness.Common
   , signalDep
   ) where
 
-import           Control.Monad               (void)
-
-import           Data.Int                    (Int32)
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
@@ -23,6 +20,7 @@ import           DBus
 import           DBus.Client
 import qualified DBus.Introspection          as I
 
+import           RIO
 import qualified RIO.Text                    as T
 
 import           XMonad.Core                 (io)
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index 9c29cae..c79b557 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@@ -12,12 +12,12 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
   , blPath
   ) where
 
-import           Data.Int                               (Int32)
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
 import           DBus
 
+import           RIO
 import           RIO.FilePath
 
 import           XMonad.Internal.DBus.Brightness.Common
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 719a4c4..bb5d4fc 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
---------------------------------------------------------------------------------
 -- | High-level interface for managing XMonad's DBus
 
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module XMonad.Internal.DBus.Control
   ( Client
   , DBusState(..)
@@ -17,14 +17,15 @@ module XMonad.Internal.DBus.Control
   , dbusExporters
   ) where
 
-import           Control.Monad
-
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
 import           DBus
 import           DBus.Client
 
+import           RIO
+import qualified RIO.Text                                       as T
+
 import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Common
@@ -37,27 +38,36 @@ data DBusState = DBusState
     }
 
 -- | Connect to the DBus
-connectDBus :: IO DBusState
+connectDBus
+  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
+  => m DBusState
 connectDBus = do
   ses <- getDBusClient
   sys <- getDBusClient
   return DBusState { dbSesClient = ses, dbSysClient = sys }
 
 -- | Disconnect from the DBus
-disconnectDBus :: DBusState -> IO ()
+disconnectDBus
+  :: (MonadUnliftIO m)
+  => DBusState -> m ()
 disconnectDBus db = disc dbSesClient >> disc dbSysClient
   where
     disc f = maybe (return ()) disconnectDBusClient $ f db
 
 -- | Connect to the DBus and request the XMonad name
-connectDBusX :: IO DBusState
+connectDBusX
+  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
+  => m DBusState
 connectDBusX = do
   db <- connectDBus
   forM_ (dbSesClient db) requestXMonadName
   return db
 
 -- | Disconnect from DBus and release the XMonad name
-disconnectDBusX :: DBusState -> IO ()
+disconnectDBusX
+  :: (MonadUnliftIO m)
+  => DBusState
+  -> m ()
 disconnectDBusX db = do
   forM_ (dbSesClient db) releaseXMonadName
   disconnectDBus db
@@ -66,18 +76,25 @@ disconnectDBusX db = do
 dbusExporters :: [Maybe SesClient -> SometimesIO]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 
-releaseXMonadName :: SesClient -> IO ()
-releaseXMonadName ses = void $ releaseName (toClient ses) xmonadBusName
+releaseXMonadName
+  :: (MonadUnliftIO m)
+  => SesClient
+  -> m ()
+releaseXMonadName ses = void $ liftIO $ releaseName (toClient ses) xmonadBusName
 
-requestXMonadName :: SesClient -> IO ()
+requestXMonadName
+  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
+  => SesClient
+  -> m ()
 requestXMonadName ses = do
-  res <- requestName (toClient ses) xmonadBusName []
+  res <- liftIO $ requestName (toClient ses) xmonadBusName []
   -- TODO if the client is not released on shutdown the owner will be different
   let msg | res == NamePrimaryOwner = Nothing
-          | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
+          | res == NameAlreadyOwner = Just "this process already owns bus name"
           | res == NameInQueue
-            || res == NameExists = Just $ "another process owns " ++ xn
-          | otherwise = Just $ "unknown error when requesting " ++ xn
-  forM_ msg putStrLn
+            || res == NameExists = Just "another process owns bus name"
+          | otherwise = Just "unknown error when requesting bus name"
+  forM_ msg $ \m ->
+    logError $ Utf8Builder $ encodeUtf8Builder $ T.concat [m, ": ", xn]
   where
-    xn = "'" ++ formatBusName xmonadBusName ++ "'"
+    xn = T.pack $ formatBusName xmonadBusName
diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs
index e891314..ed31e4a 100644
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@@ -8,15 +8,15 @@
 
 module XMonad.Internal.DBus.Removable (runRemovableMon) where
 
-import           Control.Monad
-
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
-import           Data.Map.Strict                 (Map, member)
 
 import           DBus
 import           DBus.Client
 
+import           RIO
+import qualified RIO.Map                         as M
+
 import           XMonad.Core                     (io)
 import           XMonad.Internal.Command.Desktop
 
@@ -60,7 +60,7 @@ driveFlag :: String
 driveFlag = "org.freedesktop.UDisks2.Drive"
 
 addedHasDrive :: [Variant] -> Bool
-addedHasDrive [_, a] = maybe False (member driveFlag)
+addedHasDrive [_, a] = maybe False (M.member driveFlag)
   (fromVariant a :: Maybe (Map String (Map String Variant)))
 addedHasDrive _ = False
 
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 81e8bab..8b5c6f5 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -14,15 +14,15 @@ module XMonad.Internal.DBus.Screensaver
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
-import           RIO
-
 import           DBus
 import           DBus.Client
-import qualified DBus.Introspection          as I
+import qualified DBus.Introspection                       as I
 
 import           Graphics.X11.XScreenSaver
-import           Graphics.X11.Xlib.Display
 
+import           RIO
+
+import           XMonad.Internal.Concurrent.ClientMessage
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Shell
 
@@ -45,10 +45,7 @@ toggle = do
 
 query :: IO SSState
 query = do
-  -- TODO bracket the display
-  dpy <- openDisplay ""
-  xssi <- xScreenSaverQueryInfo dpy
-  closeDisplay dpy
+  xssi <- withOpenDisplay xScreenSaverQueryInfo
   return $ case xssi of
     Just XScreenSaverInfo { xssi_state = ScreenSaverDisabled } -> False
     Just XScreenSaverInfo { xssi_state = _ }                   -> True
diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs
index 00e212f..87b374f 100644
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@@ -25,12 +25,11 @@ module XMonad.Internal.IO
   ) where
 
 import           Data.Char
-import           Data.Text       (pack, unpack)
-import           Data.Text.IO    as T (readFile, writeFile)
 
 import           RIO
 import           RIO.Directory
 import           RIO.FilePath
+import qualified RIO.Text        as T
 
 import           System.IO.Error
 
@@ -38,7 +37,7 @@ import           System.IO.Error
 -- | read
 
 readInt :: (Read a, Integral a) => FilePath -> IO a
-readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile
+readInt = fmap (read . T.unpack . T.takeWhile isDigit) . readFileUtf8
 
 readBool :: FilePath -> IO Bool
 readBool = fmap (==(1 :: Int)) . readInt
@@ -47,7 +46,7 @@ readBool = fmap (==(1 :: Int)) . readInt
 -- | write
 
 writeInt :: (Show a, Integral a) => FilePath -> a -> IO ()
-writeInt f = T.writeFile f . pack . show
+writeInt f = writeFileUtf8 f . T.pack . show
 
 writeBool :: FilePath -> Bool -> IO ()
 writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
diff --git a/lib/XMonad/Internal/Process.hs b/lib/XMonad/Internal/Process.hs
deleted file mode 100644
index 1e493d6..0000000
--- a/lib/XMonad/Internal/Process.hs
+++ /dev/null
@@ -1,17 +0,0 @@
---------------------------------------------------------------------------------
--- | Functions for managing processes
-
-module XMonad.Internal.Process where
-
--- import           Control.Exception
--- import           Control.Monad
--- import           Control.Monad.IO.Class
-
--- import qualified RIO.Text               as T
-
--- import           System.Exit
--- import           System.IO
--- import           System.Process
-
--- import           XMonad.Core            hiding (spawn)
-
diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs
index b8f9f7f..9ca7a69 100644
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@@ -10,6 +10,7 @@ module Xmobar.Plugins.BacklightCommon (startBacklight) where
 
 import           Data.Internal.DBus
 
+import           RIO
 import qualified RIO.Text              as T
 
 import           Xmobar.Plugins.Common
@@ -17,9 +18,9 @@ import           Xmobar.Plugins.Common
 startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ())
   -> (SesClient -> IO (Maybe a)) -> T.Text -> Callback -> IO ()
 startBacklight matchSignal callGetBrightness icon cb = do
-    withDBusClientConnection cb $ \c -> do
-      matchSignal display c
-      display =<< callGetBrightness c
+    withDBusClientConnection cb $ \c -> liftIO $ do
+      matchSignal dpy c
+      dpy =<< callGetBrightness c
     where
       formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"]
-      display = displayMaybe cb formatBrightness
+      dpy = displayMaybe cb formatBrightness
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 9a9dbd9..1fee0aa 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -38,19 +38,16 @@ module Xmobar.Plugins.Bluetooth
   , btDep
   ) where
 
-import           Control.Concurrent.MVar
-import           Control.Monad
-
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
-import           Data.List
 import           Data.List.Split
-import qualified Data.Map                    as M
-import           Data.Maybe
 
 import           DBus
 import           DBus.Client
 
+import           RIO
+import           RIO.List
+import qualified RIO.Map                     as M
 import qualified RIO.Text                    as T
 
 import           XMonad.Internal.DBus.Common
@@ -71,23 +68,24 @@ instance Exec Bluetooth where
   start (Bluetooth icons colors) cb =
     withDBusClientConnection cb $ startAdapter icons colors cb
 
-startAdapter :: Icons -> Colors -> Callback -> SysClient -> IO ()
+startAdapter :: MonadIO m => Icons -> Colors -> Callback -> SysClient -> m ()
 startAdapter is cs cb cl = do
   ot <- getBtObjectTree cl
+  -- TODO use RIO for this?
   state <- newMVar emptyState
-  let display = displayIcon cb (iconFormatter is cs) state
-  forM_ (findAdapter ot) $ \adapter -> do
+  let dpy = displayIcon cb (iconFormatter is cs) state
+  forM_ (findAdapter ot) $ \adapter -> liftIO $ do
     -- set up adapter
     initAdapter state adapter cl
     -- TODO this step could fail; at least warn the user...
-    void $ addAdaptorListener state display adapter cl
+    void $ addAdaptorListener state dpy adapter cl
     -- set up devices on the adapter (and listeners for adding/removing devices)
     let devices = findDevices adapter ot
-    addDeviceAddedListener state display adapter cl
-    addDeviceRemovedListener state display adapter cl
-    forM_ devices $ \d -> addAndInitDevice state display d cl
+    addDeviceAddedListener state dpy adapter cl
+    addDeviceRemovedListener state dpy adapter cl
+    forM_ devices $ \d -> addAndInitDevice state dpy d cl
     -- after setting things up, show the icon based on the initialized state
-    display
+    dpy
 
 --------------------------------------------------------------------------------
 -- | Icon Display
@@ -99,9 +97,9 @@ type IconFormatter = (Maybe Bool -> Bool -> T.Text)
 
 type Icons = (T.Text, T.Text)
 
-displayIcon :: Callback -> IconFormatter -> MutableBtState -> IO ()
+displayIcon :: MonadIO m => Callback -> IconFormatter -> MutableBtState -> m ()
 displayIcon callback formatter =
-  callback . T.unpack . uncurry formatter <=< readState
+  liftIO . callback . T.unpack . uncurry formatter <=< readState
 
 -- TODO maybe I want this to fail when any of the device statuses are Nothing
 iconFormatter :: Icons -> Colors -> IconFormatter
@@ -138,7 +136,7 @@ emptyState = BtState
   , btPowered = Nothing
   }
 
-readState :: MutableBtState -> IO (Maybe Bool, Bool)
+readState :: MonadIO m => MutableBtState -> m (Maybe Bool, Bool)
 readState state = do
   p <- readPowered state
   c <- readDevices state
@@ -161,55 +159,55 @@ adaptorHasDevice adaptor device = case splitPath device of
 splitPath :: ObjectPath -> [T.Text]
 splitPath = fmap T.pack . splitOn "/" . dropWhile (=='/') . formatObjectPath
 
-getBtObjectTree :: SysClient -> IO ObjectTree
+getBtObjectTree :: MonadIO m => SysClient -> m ObjectTree
 getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
 
 btOMPath :: ObjectPath
 btOMPath = objectPath_ "/"
 
-addBtOMListener :: SignalCallback -> SysClient -> IO ()
-addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
+addBtOMListener :: MonadIO m => SignalCallback -> SysClient -> m ()
+addBtOMListener sc = liftIO . void . addInterfaceAddedListener btBus btOMPath sc
 
-addDeviceAddedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-addDeviceAddedListener state display adapter client =
+addDeviceAddedListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m ()
+addDeviceAddedListener state dpy adapter client =
   addBtOMListener addDevice client
   where
-    addDevice = pathCallback adapter display $ \d ->
-      addAndInitDevice state display d client
+    addDevice = pathCallback adapter dpy $ \d ->
+      addAndInitDevice state dpy d client
 
-addDeviceRemovedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-addDeviceRemovedListener state display adapter sys =
+addDeviceRemovedListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m ()
+addDeviceRemovedListener state dpy adapter sys =
   addBtOMListener remDevice sys
   where
-    remDevice = pathCallback adapter display $ \d -> do
+    remDevice = pathCallback adapter dpy $ \d -> do
       old <- removeDevice state d
       forM_ old $ removeMatch (toClient sys) . btDevSigHandler
 
 pathCallback :: ObjectPath -> IO () -> (ObjectPath -> IO ()) -> SignalCallback
-pathCallback adapter display f [device, _] = forM_ (fromVariant device) $ \d ->
-  when (adaptorHasDevice adapter d) $ f d >> display
+pathCallback adapter dpy f [device, _] = forM_ (fromVariant device) $ \d ->
+  when (adaptorHasDevice adapter d) $ f d >> dpy
 pathCallback _ _ _ _ = return ()
 
 --------------------------------------------------------------------------------
 -- | Adapter
 
-initAdapter :: MutableBtState -> ObjectPath -> SysClient -> IO ()
+initAdapter :: MonadIO m => MutableBtState -> ObjectPath -> SysClient -> m ()
 initAdapter state adapter client = do
   reply <- callGetPowered adapter client
-  putPowered state $ fromSingletonVariant reply
+  liftIO $ putPowered state $ fromSingletonVariant reply
 
-matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule)
+matchBTProperty :: MonadIO m => SysClient -> ObjectPath -> m (Maybe MatchRule)
 matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
 
-addAdaptorListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
-  -> IO (Maybe SignalHandler)
-addAdaptorListener state display adaptor sys = do
+addAdaptorListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient
+  -> m (Maybe SignalHandler)
+addAdaptorListener state dpy adaptor sys = do
   rule <- matchBTProperty sys adaptor
   forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) sys
   where
-    procMatch = withSignalMatch $ \b -> putPowered state b >> display
+    procMatch = withSignalMatch $ \b -> liftIO $ putPowered state b >> dpy
 
-callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
+callGetPowered :: MonadIO m => ObjectPath -> SysClient -> m [Variant]
 callGetPowered adapter = callPropertyGet btBus adapter adapterInterface
   $ memberName_ $ T.unpack adaptorPowered
 
@@ -219,7 +217,7 @@ matchPowered = matchPropertyChanged adapterInterface adaptorPowered
 putPowered :: MutableBtState -> Maybe Bool -> IO ()
 putPowered m ds = modifyMVar_ m (\s -> return s { btPowered = ds })
 
-readPowered :: MutableBtState -> IO (Maybe Bool)
+readPowered :: MonadIO m => MutableBtState -> m (Maybe Bool)
 readPowered = fmap btPowered . readMVar
 
 adapterInterface :: InterfaceName
@@ -231,13 +229,13 @@ adaptorPowered = "Powered"
 --------------------------------------------------------------------------------
 -- | Devices
 
-addAndInitDevice :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-addAndInitDevice state display device client = do
-  sh <- addDeviceListener state display device client
+addAndInitDevice :: MonadUnliftIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m ()
+addAndInitDevice state dpy device client = do
+  sh <- addDeviceListener state dpy device client
   -- TODO add some intelligent error messages here
   forM_ sh $ \s -> initDevice state s device client
 
-initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO ()
+initDevice :: MonadUnliftIO m => MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> m ()
 initDevice state sh device sys = do
   reply <- callGetConnected device sys
   void $ insertDevice state device $
@@ -245,22 +243,22 @@ initDevice state sh device sys = do
              , btDevSigHandler = sh
              }
 
-addDeviceListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
-  -> IO (Maybe SignalHandler)
-addDeviceListener state display device sys = do
+addDeviceListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient
+  -> m (Maybe SignalHandler)
+addDeviceListener state dpy device sys = do
   rule <- matchBTProperty sys device
   forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) sys
   where
-    procMatch = withSignalMatch $ \c -> updateDevice state device c >> display
+    procMatch = withSignalMatch $ \c -> updateDevice state device c >> dpy
 
 matchConnected :: [Variant] -> SignalMatch Bool
 matchConnected = matchPropertyChanged devInterface devConnected
 
-callGetConnected :: ObjectPath -> SysClient -> IO [Variant]
+callGetConnected :: MonadIO m => ObjectPath -> SysClient -> m [Variant]
 callGetConnected p = callPropertyGet btBus p devInterface
   $ memberName_ (T.unpack devConnected)
 
-insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool
+insertDevice :: MonadUnliftIO m => MutableBtState -> ObjectPath -> BTDevice -> m Bool
 insertDevice m device dev = modifyMVar m $ \s -> do
   let new = M.insert device dev $ btDevices s
   return (s { btDevices = new }, anyDevicesConnected new)
@@ -278,7 +276,7 @@ removeDevice m device = modifyMVar m $ \s -> do
   let devs = btDevices s
   return (s { btDevices = M.delete device devs }, M.lookup device devs)
 
-readDevices :: MutableBtState -> IO ConnectedDevices
+readDevices :: MonadIO m => MutableBtState -> m ConnectedDevices
 readDevices = fmap btDevices . readMVar
 
 devInterface :: InterfaceName
diff --git a/lib/Xmobar/Plugins/ClevoKeyboard.hs b/lib/Xmobar/Plugins/ClevoKeyboard.hs
index 92a8f12..67b45f5 100644
--- a/lib/Xmobar/Plugins/ClevoKeyboard.hs
+++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs
@@ -14,7 +14,6 @@ module Xmobar.Plugins.ClevoKeyboard
 import qualified RIO.Text                                      as T
 
 import           Xmobar
-
 import           Xmobar.Plugins.BacklightCommon
 
 import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs
index d28ee2b..45b6eb0 100644
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@@ -10,18 +10,17 @@ module Xmobar.Plugins.Common
   , Callback
   , Colors(..)
   , displayMaybe
-  , displayMaybe'
+  , displayMaybe_
   , xmobarFGColor
   )
   where
 
-import           Control.Monad
-
 import           Data.Internal.DBus
 
 import           DBus
 import           DBus.Client
 
+import           RIO
 import qualified RIO.Text                as T
 
 import           XMonad.Hooks.DynamicLog (xmobarColor)
@@ -35,17 +34,21 @@ data Colors = Colors
   }
   deriving (Eq, Show, Read)
 
-startListener :: (SafeClient c, IsVariant a) => MatchRule -> (c -> IO [Variant])
+startListener :: (MonadIO m, SafeClient c, IsVariant a) => MatchRule -> (c -> m [Variant])
   -> ([Variant] -> SignalMatch a) -> (a -> IO T.Text) -> Callback
-  -> c -> IO ()
+  -> c -> m ()
 startListener rule getProp fromSignal toColor cb client = do
   reply <- getProp client
-  displayMaybe cb toColor $ fromSingletonVariant reply
+  displayMaybe cb (liftIO . toColor) $ fromSingletonVariant reply
   void $ addMatchCallback rule (procMatch . fromSignal) client
   where
     procMatch = procSignalMatch cb toColor
 
-procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO ()
+procSignalMatch
+  :: Callback
+  -> (a -> IO T.Text)
+  -> SignalMatch a
+  -> IO ()
 procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
 
 colorText :: Colors -> Bool -> T.Text -> T.Text
@@ -58,11 +61,17 @@ xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack
 na :: T.Text
 na = "N/A"
 
-displayMaybe :: Callback -> (a -> IO T.Text) -> Maybe a -> IO ()
-displayMaybe cb f = (cb . T.unpack) <=< maybe (return na) f
+displayMaybe :: (MonadIO m) => Callback -> (a -> m T.Text) -> Maybe a -> m ()
+displayMaybe cb f = (liftIO . cb . T.unpack) <=< maybe (return na) f
 
-displayMaybe' :: Callback -> (a -> IO ()) -> Maybe a -> IO ()
-displayMaybe' cb = maybe (cb $ T.unpack na)
+displayMaybe_ :: MonadIO m => Callback -> (a -> m ()) -> Maybe a -> m ()
+displayMaybe_ cb = maybe (liftIO $ cb $ T.unpack na)
 
-withDBusClientConnection :: SafeClient c => Callback -> (c -> IO ()) -> IO ()
-withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient
+withDBusClientConnection
+  :: (SafeClient c)
+  => Callback
+  -> (c -> RIO SimpleApp ())
+  -> IO ()
+withDBusClientConnection cb f = do
+  -- TODO be more sophisticated
+  runSimpleApp $ withDBusClient_ $ displayMaybe_ cb f . Just
diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index 13abdb0..e16db36 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -11,14 +11,12 @@ module Xmobar.Plugins.Device
   , devDep
   ) where
 
-import           Control.Monad
-
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
-import           Data.Word
 
 import           DBus
 
+import           RIO
 import qualified RIO.Text                        as T
 
 import           XMonad.Internal.Command.Desktop
@@ -64,9 +62,9 @@ matchStatus = matchPropertyChanged nmDeviceInterface devSignal
 instance Exec Device where
   alias (Device (iface, _, _)) = T.unpack iface
   start (Device (iface, text, colors)) cb = do
-    withDBusClientConnection cb $ \sys -> do
+    withDBusClientConnection cb $ \sys -> liftIO $ do
       path <- getDevice sys iface
-      displayMaybe' cb (listener sys) path
+      displayMaybe_ cb (listener sys) path
     where
       listener sys path = do
         rule <- matchPropertyFull sys networkManagerBus (Just path)
diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs
index e60a0fd..d9f35b3 100644
--- a/lib/Xmobar/Plugins/IntelBacklight.hs
+++ b/lib/Xmobar/Plugins/IntelBacklight.hs
@@ -14,7 +14,6 @@ module Xmobar.Plugins.IntelBacklight
 import qualified RIO.Text                                       as T
 
 import           Xmobar
-
 import           Xmobar.Plugins.BacklightCommon
 
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs
index ef125cb..c511216 100644
--- a/lib/Xmobar/Plugins/Screensaver.hs
+++ b/lib/Xmobar/Plugins/Screensaver.hs
@@ -11,6 +11,7 @@ module Xmobar.Plugins.Screensaver
   , ssAlias
   ) where
 
+import           RIO
 import qualified RIO.Text                         as T
 
 import           Xmobar
@@ -26,9 +27,9 @@ ssAlias = "screensaver"
 instance Exec Screensaver where
   alias (Screensaver _) = T.unpack ssAlias
   start (Screensaver (text, colors)) cb = do
-    withDBusClientConnection cb $ \sys -> do
-      matchSignal display sys
-      display =<< callQuery sys
+    withDBusClientConnection cb $ \sys -> liftIO $ do
+      matchSignal dpy sys
+      dpy =<< callQuery sys
     where
-      display = displayMaybe cb $ return . (\s -> colorText colors s text)
+      dpy = displayMaybe cb $ return . (\s -> colorText colors s text)
 
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index 625abf8..c617d68 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -13,17 +13,15 @@ module Xmobar.Plugins.VPN
   , vpnDep
   ) where
 
-import           Control.Concurrent.MVar
-import           Control.Monad
 
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
-import qualified Data.Map                        as M
-import           Data.Maybe
-import qualified Data.Set                        as S
 
 import           DBus
 
+import           RIO
+import qualified RIO.Map                         as M
+import qualified RIO.Set                         as S
 import qualified RIO.Text                        as T
 
 import           XMonad.Internal.Command.Desktop
@@ -38,11 +36,11 @@ instance Exec VPN where
   start (VPN (text, colors)) cb =
     withDBusClientConnection cb $ \c -> do
     state <- initState c
-    let display = displayMaybe cb iconFormatter . Just =<< readState state
-    let signalCallback' f = f state display
+    let dpy = displayMaybe cb iconFormatter . Just =<< readState state
+    let signalCallback' f = f state dpy
     vpnAddedListener (signalCallback' addedCallback) c
     vpnRemovedListener (signalCallback' removedCallback) c
-    display
+    liftIO dpy
     where
       iconFormatter b = return $ colorText colors b text
 
@@ -57,7 +55,7 @@ type VPNState = S.Set ObjectPath
 
 type MutableVPNState = MVar VPNState
 
-initState :: SysClient -> IO MutableVPNState
+initState :: MonadIO m => SysClient -> m MutableVPNState
 initState client = do
   ot <- getVPNObjectTree client
   newMVar $ findTunnels ot
@@ -65,28 +63,28 @@ initState client = do
 readState :: MutableVPNState -> IO Bool
 readState = fmap (not . null) . readMVar
 
-updateState :: (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
-  -> ObjectPath -> IO ()
+updateState :: MonadUnliftIO m => (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
+  -> ObjectPath -> m ()
 updateState f state op = modifyMVar_ state $ return . f op
 
 --------------------------------------------------------------------------------
 -- | Tunnel Device Detection
 --
 
-getVPNObjectTree :: SysClient -> IO ObjectTree
+getVPNObjectTree :: MonadIO m => SysClient -> m ObjectTree
 getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
 
 findTunnels :: ObjectTree -> VPNState
 findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
 
-vpnAddedListener :: SignalCallback -> SysClient -> IO ()
+vpnAddedListener :: MonadIO m => SignalCallback -> SysClient -> m ()
 vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
 
-vpnRemovedListener :: SignalCallback -> SysClient -> IO ()
+vpnRemovedListener :: MonadIO m => SignalCallback -> SysClient -> m ()
 vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
 
 addedCallback :: MutableVPNState -> IO () -> SignalCallback
-addedCallback state display [device, added] = update >> display
+addedCallback state dpy [device, added] = update >> dpy
   where
     added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant))
     is = M.keys $ fromMaybe M.empty added'
@@ -94,7 +92,7 @@ addedCallback state display [device, added] = update >> display
 addedCallback _ _ _                       = return ()
 
 removedCallback :: MutableVPNState -> IO () -> SignalCallback
-removedCallback state display [device, interfaces] = update >> display
+removedCallback state dpy [device, interfaces] = update >> dpy
   where
     is = fromMaybe [] $ fromVariant interfaces :: [T.Text]
     update = updateDevice S.delete state device is

From d560db1548dd5b7e01684fdbdf497cefdd3873fd Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 10:56:09 -0500
Subject: [PATCH 026/118] Revert "WIP use unliftio everywhere-ish"

This reverts commit 769df2fb002f2e78d79e680aca8bbff4faf232bf.
---
 bin/xmobar.hs                                 |  23 ++-
 bin/xmonad.hs                                 |   9 +-
 lib/Data/Internal/DBus.hs                     | 144 ++++++------------
 lib/Data/Internal/Dependency.hs               |  31 ++--
 lib/XMonad/Internal/Command/DMenu.hs          |   5 +-
 lib/XMonad/Internal/Command/Desktop.hs        |   2 +-
 lib/XMonad/Internal/Command/Power.hs          |   6 +-
 .../Internal/Concurrent/ClientMessage.hs      |   1 -
 .../Internal/Concurrent/DynamicWorkspaces.hs  |  15 +-
 lib/XMonad/Internal/Concurrent/VirtualBox.hs  |   4 +-
 .../Internal/DBus/Brightness/ClevoKeyboard.hs |   4 +-
 lib/XMonad/Internal/DBus/Brightness/Common.hs |   4 +-
 .../DBus/Brightness/IntelBacklight.hs         |   2 +-
 lib/XMonad/Internal/DBus/Control.hs           |  53 +++----
 lib/XMonad/Internal/DBus/Removable.hs         |   8 +-
 lib/XMonad/Internal/DBus/Screensaver.hs       |  19 ++-
 lib/XMonad/Internal/IO.hs                     |   7 +-
 lib/XMonad/Internal/Process.hs                |  17 +++
 lib/Xmobar/Plugins/BacklightCommon.hs         |   9 +-
 lib/Xmobar/Plugins/Bluetooth.hs               |  96 ++++++------
 lib/Xmobar/Plugins/ClevoKeyboard.hs           |   1 +
 lib/Xmobar/Plugins/Common.hs                  |  35 ++---
 lib/Xmobar/Plugins/Device.hs                  |   8 +-
 lib/Xmobar/Plugins/IntelBacklight.hs          |   1 +
 lib/Xmobar/Plugins/Screensaver.hs             |   9 +-
 lib/Xmobar/Plugins/VPN.hs                     |  30 ++--
 26 files changed, 258 insertions(+), 285 deletions(-)
 create mode 100644 lib/XMonad/Internal/Process.hs

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 4f2e496..4a56132 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -56,20 +56,17 @@ main = getArgs >>= parse
 parse :: [String] -> IO ()
 parse []         = run
 parse ["--deps"] = withCache printDeps
-parse ["--test"] = withCache $ do
-  db <- connectDBus
-  void $ evalConfig db
+parse ["--test"] = void $ withCache . evalConfig =<< connectDBus
 parse _          = usage
 
 run :: IO ()
-run =
-  withCache $ do
-    db <- connectDBus
-    c <- evalConfig db
-    disconnectDBus db
-    -- this is needed to see any printed messages
-    liftIO $ hFlush stdout
-    liftIO $ xmobar c
+run = do
+  db <- connectDBus
+  c <- withCache $ evalConfig db
+  disconnectDBus db
+  -- this is needed to see any printed messages
+  hFlush stdout
+  xmobar c
 
 evalConfig :: DBusState -> FIO Config
 evalConfig db = do
@@ -81,10 +78,10 @@ evalConfig db = do
 
 printDeps :: FIO ()
 printDeps = do
-  db <- connectDBus
+  db <- io connectDBus
   let ps = sort $ nub $ fmap showFulfillment $ concatMap dumpFeature $ allFeatures db
   io $ mapM_ (putStrLn . T.unpack) ps
-  disconnectDBus db
+  io $ disconnectDBus db
 
 usage :: IO ()
 usage = putStrLn $ intercalate "\n"
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 75ed5c4..316b242 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -8,8 +8,12 @@
 
 module Main (main) where
 
+import           Control.Monad
+
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
+import           Data.List
+import           Data.Maybe
 import           Data.Monoid
 import           Data.Text.IO                                   (hPutStrLn)
 
@@ -19,7 +23,6 @@ import           Graphics.X11.Xlib.Extras
 
 import           RIO
 import           RIO.Directory
-import           RIO.List
 import           RIO.Process
 import qualified RIO.Text                                       as T
 
@@ -201,7 +204,7 @@ startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
 
 withDBusX :: (DBusState -> FIO a) -> FIO a
-withDBusX = bracket connectDBusX cleanup
+withDBusX = bracket (io connectDBusX) cleanup
   where
     cleanup db = do
       logInfo "unregistering xmonad from DBus"
@@ -223,7 +226,7 @@ withXmobar = bracket startXmobar cleanup
 
 printDeps :: FIO ()
 printDeps = do
-  db <- connectDBus
+  db <- io connectDBus
   (i, f, d) <- allFeatures db
   io $ mapM_ (putStrLn . T.unpack)
     $ fmap showFulfillment
diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 94a8c8f..0bfe459 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -27,9 +27,14 @@ module Data.Internal.DBus
   , bodyToMaybe
   ) where
 
-import           RIO
-import qualified RIO.Map     as M
-import qualified RIO.Text    as T
+import           Control.Exception
+import           Control.Monad
+
+import           Data.Bifunctor
+import qualified Data.Map.Strict   as M
+import           Data.Maybe
+
+import qualified RIO.Text          as T
 
 import           DBus
 import           DBus.Client
@@ -40,38 +45,23 @@ import           DBus.Client
 class SafeClient c where
   toClient :: c -> Client
 
-  getDBusClient
-    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-    => m (Maybe c)
+  getDBusClient :: IO (Maybe c)
 
-  disconnectDBusClient
-    :: (MonadUnliftIO m)
-    => c
-    -> m ()
-  disconnectDBusClient = liftIO . disconnect . toClient
+  disconnectDBusClient :: c -> IO ()
+  disconnectDBusClient = disconnect . toClient
 
-  withDBusClient
-    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-    => (c -> m a)
-    -> m (Maybe a)
-  -- TODO bracket
+  withDBusClient :: (c -> IO a) -> IO (Maybe a)
   withDBusClient f = do
     client <- getDBusClient
     forM client $ \c -> do
       r <- f c
-      liftIO $ disconnect (toClient c)
+      disconnect (toClient c)
       return r
 
-  withDBusClient_
-    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-    => (c -> m ())
-    -> m ()
+  withDBusClient_ :: (c -> IO ()) -> IO ()
   withDBusClient_ = void . withDBusClient
 
-  fromDBusClient
-    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-    => (c -> a)
-    -> m (Maybe a)
+  fromDBusClient :: (c -> a) -> IO (Maybe a)
   fromDBusClient f = withDBusClient (return . f)
 
 newtype SysClient = SysClient Client
@@ -79,25 +69,20 @@ newtype SysClient = SysClient Client
 instance SafeClient SysClient where
   toClient (SysClient cl) = cl
 
-  getDBusClient = fmap SysClient <$> getDBusClient_ True
+  getDBusClient = fmap SysClient <$> getDBusClient' True
 
 newtype SesClient = SesClient Client
 
 instance SafeClient SesClient where
   toClient (SesClient cl) = cl
 
-  getDBusClient = fmap SesClient <$> getDBusClient_ False
+  getDBusClient = fmap SesClient <$> getDBusClient' False
 
-getDBusClient_
-  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-  => Bool
-  -> m (Maybe Client)
-getDBusClient_ sys = do
-  res <- try $ liftIO $ if sys then connectSystem else connectSession
+getDBusClient' :: Bool -> IO (Maybe Client)
+getDBusClient' sys = do
+  res <- try $ if sys then connectSystem else connectSession
   case res of
-    Left e  -> do
-      logError $ Utf8Builder $ encodeUtf8Builder $ T.pack $ clientErrorMessage e
-      return Nothing
+    Left e  -> putStrLn (clientErrorMessage e) >> return Nothing
     Right c -> return $ Just c
 
 --------------------------------------------------------------------------------
@@ -105,14 +90,12 @@ getDBusClient_ sys = do
 
 type MethodBody = Either T.Text [Variant]
 
-callMethod' :: (MonadIO m, SafeClient c) => c -> MethodCall -> m MethodBody
-callMethod' cl =
-  liftIO
-  . fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
+callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody
+callMethod' cl = fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
   . call (toClient cl)
 
-callMethod :: (MonadIO m, SafeClient c) => c -> BusName -> ObjectPath -> InterfaceName
-  -> MemberName -> m MethodBody
+callMethod :: SafeClient c => c -> BusName -> ObjectPath -> InterfaceName
+  -> MemberName -> IO MethodBody
 callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
 
 methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
@@ -125,7 +108,7 @@ methodCallBus b p i m = (methodCall p i m)
 dbusInterface :: InterfaceName
 dbusInterface = interfaceName_ "org.freedesktop.DBus"
 
-callGetNameOwner :: (MonadIO m, SafeClient c) => c -> BusName -> m (Maybe BusName)
+callGetNameOwner :: SafeClient c => c -> BusName -> IO (Maybe BusName)
 callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
   where
     mc = (methodCallBus dbusName dbusPath dbusInterface mem)
@@ -146,14 +129,9 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant
 
 type SignalCallback = [Variant] -> IO ()
 
-addMatchCallback
-  :: (MonadIO m, SafeClient c)
-  => MatchRule
-  -> SignalCallback
-  -> c
-  -> m SignalHandler
-addMatchCallback rule cb cl =
-  liftIO $ addMatch (toClient cl) rule $ cb . signalBody
+addMatchCallback :: SafeClient c => MatchRule -> SignalCallback -> c
+  -> IO SignalHandler
+addMatchCallback rule cb cl = addMatch (toClient cl) rule $ cb . signalBody
 
 matchSignal :: Maybe BusName -> Maybe ObjectPath -> Maybe InterfaceName
   -> Maybe MemberName -> MatchRule
@@ -164,14 +142,8 @@ matchSignal b p i m = matchAny
   , matchMember = m
   }
 
-matchSignalFull
-  :: (MonadIO m, SafeClient c)
-  => c
-  -> BusName
-  -> Maybe ObjectPath
-  -> Maybe InterfaceName
-  -> Maybe MemberName
-  -> m (Maybe MatchRule)
+matchSignalFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
+  -> Maybe InterfaceName -> Maybe MemberName -> IO (Maybe MatchRule)
 matchSignalFull client b p i m =
   fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
 
@@ -184,29 +156,23 @@ propertyInterface = interfaceName_ "org.freedesktop.DBus.Properties"
 propertySignal :: MemberName
 propertySignal = memberName_ "PropertiesChanged"
 
-callPropertyGet :: (MonadIO m, SafeClient c) => BusName -> ObjectPath -> InterfaceName
-  -> MemberName -> c -> m [Variant]
-callPropertyGet bus path iface property cl =
-  liftIO
-  $ fmap (either (const []) (:[]))
+callPropertyGet :: SafeClient c => BusName -> ObjectPath -> InterfaceName
+  -> MemberName -> c -> IO [Variant]
+callPropertyGet bus path iface property cl = fmap (either (const []) (:[]))
   $ getProperty (toClient cl) $ methodCallBus bus path iface property
 
 matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
 matchProperty b p =
   matchSignal b p (Just propertyInterface) (Just propertySignal)
 
-matchPropertyFull
-  :: (MonadIO m, SafeClient c)
-  => c
-  -> BusName
-  -> Maybe ObjectPath
-  -> m (Maybe MatchRule)
+matchPropertyFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
+  -> IO (Maybe MatchRule)
 matchPropertyFull cl b p =
   matchSignalFull cl b p (Just propertyInterface) (Just propertySignal)
 
 data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show)
 
-withSignalMatch :: Monad m => (Maybe a -> m ()) -> SignalMatch a -> m ()
+withSignalMatch :: (Maybe a -> IO ()) -> SignalMatch a -> IO ()
 withSignalMatch f (Match x) = f (Just x)
 withSignalMatch f Failure   = f Nothing
 withSignalMatch _ NoMatch   = return ()
@@ -242,44 +208,24 @@ omInterfacesAdded = memberName_ "InterfacesAdded"
 omInterfacesRemoved :: MemberName
 omInterfacesRemoved = memberName_ "InterfacesRemoved"
 
-callGetManagedObjects
-  :: (MonadIO m, SafeClient c)
-  => c
-  -> BusName
-  -> ObjectPath
-  -> m ObjectTree
+callGetManagedObjects :: SafeClient c => c -> BusName -> ObjectPath
+  -> IO ObjectTree
 callGetManagedObjects cl bus path =
   either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
   <$> callMethod cl bus path omInterface getManagedObjects
 
-addInterfaceChangedListener
-  :: (MonadIO m, SafeClient c)
-  => BusName
-  -> MemberName
-  -> ObjectPath
-  -> SignalCallback
-  -> c
-  -> m (Maybe SignalHandler)
+addInterfaceChangedListener :: SafeClient c => BusName -> MemberName
+  -> ObjectPath -> SignalCallback -> c -> IO (Maybe SignalHandler)
 addInterfaceChangedListener bus prop path sc cl = do
   rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
   forM rule $ \r -> addMatchCallback r sc cl
 
-addInterfaceAddedListener
-  :: (MonadIO m, SafeClient c)
-  => BusName
-  -> ObjectPath
-  -> SignalCallback
-  -> c
-  -> m (Maybe SignalHandler)
+addInterfaceAddedListener :: SafeClient c => BusName -> ObjectPath
+  -> SignalCallback -> c -> IO (Maybe SignalHandler)
 addInterfaceAddedListener bus =
   addInterfaceChangedListener bus omInterfacesAdded
 
-addInterfaceRemovedListener
-  :: (MonadIO m, SafeClient c)
-  => BusName
-  -> ObjectPath
-  -> SignalCallback
-  -> c
-  -> m (Maybe SignalHandler)
+addInterfaceRemovedListener :: SafeClient c => BusName -> ObjectPath
+  -> SignalCallback -> c -> IO (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
   addInterfaceChangedListener bus omInterfacesRemoved
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index 6a23520..930ce34 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -106,31 +106,38 @@ module Data.Internal.Dependency
   , shellTest
   ) where
 
-import           Data.Aeson            hiding (Error, Result)
+import           Control.Monad.IO.Class
+import           Control.Monad.Identity
+import           Control.Monad.Reader
+
+import           Data.Aeson             hiding (Error, Result)
 import           Data.Aeson.Key
+import           Data.Bifunctor
+import           Data.Either
 import           Data.Internal.DBus
+import           Data.List
+import           Data.Maybe
 import           Data.Yaml
 
-import           GHC.IO.Exception      (ioe_description)
+import           GHC.IO.Exception       (ioe_description)
 
-import           DBus                  hiding (typeOf)
-import qualified DBus.Introspection    as I
+import           DBus                   hiding (typeOf)
+import qualified DBus.Introspection     as I
 
-import           RIO                   hiding (bracket, fromString)
-import           RIO.Directory
+import           RIO                    hiding (bracket, fromString)
 import           RIO.FilePath
-import           RIO.List
-import           RIO.Process           hiding (findExecutable)
-import qualified RIO.Text              as T
+import           RIO.Process            hiding (findExecutable)
+import qualified RIO.Text               as T
 
+import           System.Directory
 import           System.Environment
 import           System.IO.Error
 import           System.Posix.Files
-import           System.Process.Typed  (nullStream)
+import           System.Process.Typed   (nullStream)
 
-import           XMonad.Core           (X, io)
+import           XMonad.Core            (X, io)
 import           XMonad.Internal.IO
-import           XMonad.Internal.Shell hiding (proc, runProcess)
+import           XMonad.Internal.Shell  hiding (proc, runProcess)
 import           XMonad.Internal.Theme
 
 --------------------------------------------------------------------------------
diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index 5d69630..2fb2477 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -24,9 +24,12 @@ import           DBus
 
 import           Graphics.X11.Types
 
-import           RIO.Directory
 import qualified RIO.Text                        as T
 
+import           System.Directory
+    ( XdgDirectory (..)
+    , getXdgDirectory
+    )
 import           System.IO
 
 import           XMonad.Core                     hiding (spawn)
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 509bca0..6a4d00c 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -47,11 +47,11 @@ import           Data.Internal.Dependency
 import           DBus
 
 import           RIO
-import           RIO.Directory
 import           RIO.FilePath
 import qualified RIO.Process                 as P
 import qualified RIO.Text                    as T
 
+import           System.Directory
 import           System.Environment
 import           System.Posix.User
 
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index f376aa5..f9a83b2 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -29,15 +29,17 @@ module XMonad.Internal.Command.Power
 
 import           Data.Internal.Dependency
 
+import           Data.Either
+import qualified Data.Map                    as M
+
 import           Graphics.X11.Types
 
 import           RIO
-import           RIO.Directory
 import           RIO.FilePath
-import qualified RIO.Map                     as M
 import qualified RIO.Process                 as P
 import qualified RIO.Text                    as T
 
+import           System.Directory
 import           System.IO.Error
 
 import           XMonad.Core                 hiding (spawn)
diff --git a/lib/XMonad/Internal/Concurrent/ClientMessage.hs b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
index deda5a8..d5ee052 100644
--- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs
+++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
@@ -19,7 +19,6 @@ module XMonad.Internal.Concurrent.ClientMessage
   ( XMsgType(..)
   , sendXMsg
   , splitXMsg
-  , withOpenDisplay
   ) where
 
 import           Data.Char
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index 3a43626..4944611 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -33,7 +33,17 @@ module XMonad.Internal.Concurrent.DynamicWorkspaces
   , doSink
   ) where
 
+import           Data.List                                (deleteBy, find)
+import qualified Data.Map                                 as M
+import           Data.Maybe
+
+-- import           Control.Concurrent
+import           Control.Monad
+import           Control.Monad.Reader
+
+
 import           Graphics.X11.Types
+
 import           Graphics.X11.Xlib.Atom
 import           Graphics.X11.Xlib.Display
 import           Graphics.X11.Xlib.Event
@@ -45,8 +55,6 @@ import           RIO                                      hiding
     ( Display
     , display
     )
-import           RIO.List
-import qualified RIO.Map                                  as M
 import qualified RIO.Set                                  as S
 
 import           System.Process
@@ -98,6 +106,9 @@ data WConf = WConf
 
 type W a = RIO WConf ()
 
+withOpenDisplay :: (Display -> IO a) -> IO a
+withOpenDisplay = bracket (openDisplay "") closeDisplay
+
 runWorkspaceMon :: [DynWorkspace] -> IO ()
 runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
   root <- rootWindow dpy $ defaultScreen dpy
diff --git a/lib/XMonad/Internal/Concurrent/VirtualBox.hs b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
index 2695e74..7d1f857 100644
--- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs
+++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
@@ -12,13 +12,13 @@ module XMonad.Internal.Concurrent.VirtualBox
 
 import           Data.Internal.Dependency
 
+import           Text.XML.Light
+
 import           RIO                      hiding (try)
 import           RIO.Directory
 import           RIO.FilePath
 import qualified RIO.Text                 as T
 
-import           Text.XML.Light
-
 import           XMonad.Internal.Shell
 
 vmExists :: T.Text -> IO (Maybe Msg)
diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
index 1ce79f8..3395f4b 100644
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@@ -12,12 +12,14 @@ module XMonad.Internal.DBus.Brightness.ClevoKeyboard
   , blPath
   ) where
 
+import           Control.Monad                          (when)
+
+import           Data.Int                               (Int32)
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
 import           DBus
 
-import           RIO
 import           RIO.FilePath
 
 import           XMonad.Internal.DBus.Brightness.Common
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 05e6313..8146055 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -13,6 +13,9 @@ module XMonad.Internal.DBus.Brightness.Common
   , signalDep
   ) where
 
+import           Control.Monad               (void)
+
+import           Data.Int                    (Int32)
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
@@ -20,7 +23,6 @@ import           DBus
 import           DBus.Client
 import qualified DBus.Introspection          as I
 
-import           RIO
 import qualified RIO.Text                    as T
 
 import           XMonad.Core                 (io)
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index c79b557..9c29cae 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@@ -12,12 +12,12 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
   , blPath
   ) where
 
+import           Data.Int                               (Int32)
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
 import           DBus
 
-import           RIO
 import           RIO.FilePath
 
 import           XMonad.Internal.DBus.Brightness.Common
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index bb5d4fc..719a4c4 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -1,8 +1,8 @@
--- | High-level interface for managing XMonad's DBus
-
-{-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
+--------------------------------------------------------------------------------
+-- | High-level interface for managing XMonad's DBus
+
 module XMonad.Internal.DBus.Control
   ( Client
   , DBusState(..)
@@ -17,15 +17,14 @@ module XMonad.Internal.DBus.Control
   , dbusExporters
   ) where
 
+import           Control.Monad
+
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
 import           DBus
 import           DBus.Client
 
-import           RIO
-import qualified RIO.Text                                       as T
-
 import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Common
@@ -38,36 +37,27 @@ data DBusState = DBusState
     }
 
 -- | Connect to the DBus
-connectDBus
-  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-  => m DBusState
+connectDBus :: IO DBusState
 connectDBus = do
   ses <- getDBusClient
   sys <- getDBusClient
   return DBusState { dbSesClient = ses, dbSysClient = sys }
 
 -- | Disconnect from the DBus
-disconnectDBus
-  :: (MonadUnliftIO m)
-  => DBusState -> m ()
+disconnectDBus :: DBusState -> IO ()
 disconnectDBus db = disc dbSesClient >> disc dbSysClient
   where
     disc f = maybe (return ()) disconnectDBusClient $ f db
 
 -- | Connect to the DBus and request the XMonad name
-connectDBusX
-  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-  => m DBusState
+connectDBusX :: IO DBusState
 connectDBusX = do
   db <- connectDBus
   forM_ (dbSesClient db) requestXMonadName
   return db
 
 -- | Disconnect from DBus and release the XMonad name
-disconnectDBusX
-  :: (MonadUnliftIO m)
-  => DBusState
-  -> m ()
+disconnectDBusX :: DBusState -> IO ()
 disconnectDBusX db = do
   forM_ (dbSesClient db) releaseXMonadName
   disconnectDBus db
@@ -76,25 +66,18 @@ disconnectDBusX db = do
 dbusExporters :: [Maybe SesClient -> SometimesIO]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 
-releaseXMonadName
-  :: (MonadUnliftIO m)
-  => SesClient
-  -> m ()
-releaseXMonadName ses = void $ liftIO $ releaseName (toClient ses) xmonadBusName
+releaseXMonadName :: SesClient -> IO ()
+releaseXMonadName ses = void $ releaseName (toClient ses) xmonadBusName
 
-requestXMonadName
-  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-  => SesClient
-  -> m ()
+requestXMonadName :: SesClient -> IO ()
 requestXMonadName ses = do
-  res <- liftIO $ requestName (toClient ses) xmonadBusName []
+  res <- requestName (toClient ses) xmonadBusName []
   -- TODO if the client is not released on shutdown the owner will be different
   let msg | res == NamePrimaryOwner = Nothing
-          | res == NameAlreadyOwner = Just "this process already owns bus name"
+          | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
           | res == NameInQueue
-            || res == NameExists = Just "another process owns bus name"
-          | otherwise = Just "unknown error when requesting bus name"
-  forM_ msg $ \m ->
-    logError $ Utf8Builder $ encodeUtf8Builder $ T.concat [m, ": ", xn]
+            || res == NameExists = Just $ "another process owns " ++ xn
+          | otherwise = Just $ "unknown error when requesting " ++ xn
+  forM_ msg putStrLn
   where
-    xn = T.pack $ formatBusName xmonadBusName
+    xn = "'" ++ formatBusName xmonadBusName ++ "'"
diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs
index ed31e4a..e891314 100644
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@@ -8,15 +8,15 @@
 
 module XMonad.Internal.DBus.Removable (runRemovableMon) where
 
+import           Control.Monad
+
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
+import           Data.Map.Strict                 (Map, member)
 
 import           DBus
 import           DBus.Client
 
-import           RIO
-import qualified RIO.Map                         as M
-
 import           XMonad.Core                     (io)
 import           XMonad.Internal.Command.Desktop
 
@@ -60,7 +60,7 @@ driveFlag :: String
 driveFlag = "org.freedesktop.UDisks2.Drive"
 
 addedHasDrive :: [Variant] -> Bool
-addedHasDrive [_, a] = maybe False (M.member driveFlag)
+addedHasDrive [_, a] = maybe False (member driveFlag)
   (fromVariant a :: Maybe (Map String (Map String Variant)))
 addedHasDrive _ = False
 
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 8b5c6f5..81e8bab 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -14,15 +14,15 @@ module XMonad.Internal.DBus.Screensaver
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
-import           DBus
-import           DBus.Client
-import qualified DBus.Introspection                       as I
-
-import           Graphics.X11.XScreenSaver
-
 import           RIO
 
-import           XMonad.Internal.Concurrent.ClientMessage
+import           DBus
+import           DBus.Client
+import qualified DBus.Introspection          as I
+
+import           Graphics.X11.XScreenSaver
+import           Graphics.X11.Xlib.Display
+
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Shell
 
@@ -45,7 +45,10 @@ toggle = do
 
 query :: IO SSState
 query = do
-  xssi <- withOpenDisplay xScreenSaverQueryInfo
+  -- TODO bracket the display
+  dpy <- openDisplay ""
+  xssi <- xScreenSaverQueryInfo dpy
+  closeDisplay dpy
   return $ case xssi of
     Just XScreenSaverInfo { xssi_state = ScreenSaverDisabled } -> False
     Just XScreenSaverInfo { xssi_state = _ }                   -> True
diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs
index 87b374f..00e212f 100644
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@@ -25,11 +25,12 @@ module XMonad.Internal.IO
   ) where
 
 import           Data.Char
+import           Data.Text       (pack, unpack)
+import           Data.Text.IO    as T (readFile, writeFile)
 
 import           RIO
 import           RIO.Directory
 import           RIO.FilePath
-import qualified RIO.Text        as T
 
 import           System.IO.Error
 
@@ -37,7 +38,7 @@ import           System.IO.Error
 -- | read
 
 readInt :: (Read a, Integral a) => FilePath -> IO a
-readInt = fmap (read . T.unpack . T.takeWhile isDigit) . readFileUtf8
+readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile
 
 readBool :: FilePath -> IO Bool
 readBool = fmap (==(1 :: Int)) . readInt
@@ -46,7 +47,7 @@ readBool = fmap (==(1 :: Int)) . readInt
 -- | write
 
 writeInt :: (Show a, Integral a) => FilePath -> a -> IO ()
-writeInt f = writeFileUtf8 f . T.pack . show
+writeInt f = T.writeFile f . pack . show
 
 writeBool :: FilePath -> Bool -> IO ()
 writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
diff --git a/lib/XMonad/Internal/Process.hs b/lib/XMonad/Internal/Process.hs
new file mode 100644
index 0000000..1e493d6
--- /dev/null
+++ b/lib/XMonad/Internal/Process.hs
@@ -0,0 +1,17 @@
+--------------------------------------------------------------------------------
+-- | Functions for managing processes
+
+module XMonad.Internal.Process where
+
+-- import           Control.Exception
+-- import           Control.Monad
+-- import           Control.Monad.IO.Class
+
+-- import qualified RIO.Text               as T
+
+-- import           System.Exit
+-- import           System.IO
+-- import           System.Process
+
+-- import           XMonad.Core            hiding (spawn)
+
diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs
index 9ca7a69..b8f9f7f 100644
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@@ -10,7 +10,6 @@ module Xmobar.Plugins.BacklightCommon (startBacklight) where
 
 import           Data.Internal.DBus
 
-import           RIO
 import qualified RIO.Text              as T
 
 import           Xmobar.Plugins.Common
@@ -18,9 +17,9 @@ import           Xmobar.Plugins.Common
 startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ())
   -> (SesClient -> IO (Maybe a)) -> T.Text -> Callback -> IO ()
 startBacklight matchSignal callGetBrightness icon cb = do
-    withDBusClientConnection cb $ \c -> liftIO $ do
-      matchSignal dpy c
-      dpy =<< callGetBrightness c
+    withDBusClientConnection cb $ \c -> do
+      matchSignal display c
+      display =<< callGetBrightness c
     where
       formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"]
-      dpy = displayMaybe cb formatBrightness
+      display = displayMaybe cb formatBrightness
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 1fee0aa..9a9dbd9 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -38,16 +38,19 @@ module Xmobar.Plugins.Bluetooth
   , btDep
   ) where
 
+import           Control.Concurrent.MVar
+import           Control.Monad
+
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
+import           Data.List
 import           Data.List.Split
+import qualified Data.Map                    as M
+import           Data.Maybe
 
 import           DBus
 import           DBus.Client
 
-import           RIO
-import           RIO.List
-import qualified RIO.Map                     as M
 import qualified RIO.Text                    as T
 
 import           XMonad.Internal.DBus.Common
@@ -68,24 +71,23 @@ instance Exec Bluetooth where
   start (Bluetooth icons colors) cb =
     withDBusClientConnection cb $ startAdapter icons colors cb
 
-startAdapter :: MonadIO m => Icons -> Colors -> Callback -> SysClient -> m ()
+startAdapter :: Icons -> Colors -> Callback -> SysClient -> IO ()
 startAdapter is cs cb cl = do
   ot <- getBtObjectTree cl
-  -- TODO use RIO for this?
   state <- newMVar emptyState
-  let dpy = displayIcon cb (iconFormatter is cs) state
-  forM_ (findAdapter ot) $ \adapter -> liftIO $ do
+  let display = displayIcon cb (iconFormatter is cs) state
+  forM_ (findAdapter ot) $ \adapter -> do
     -- set up adapter
     initAdapter state adapter cl
     -- TODO this step could fail; at least warn the user...
-    void $ addAdaptorListener state dpy adapter cl
+    void $ addAdaptorListener state display adapter cl
     -- set up devices on the adapter (and listeners for adding/removing devices)
     let devices = findDevices adapter ot
-    addDeviceAddedListener state dpy adapter cl
-    addDeviceRemovedListener state dpy adapter cl
-    forM_ devices $ \d -> addAndInitDevice state dpy d cl
+    addDeviceAddedListener state display adapter cl
+    addDeviceRemovedListener state display adapter cl
+    forM_ devices $ \d -> addAndInitDevice state display d cl
     -- after setting things up, show the icon based on the initialized state
-    dpy
+    display
 
 --------------------------------------------------------------------------------
 -- | Icon Display
@@ -97,9 +99,9 @@ type IconFormatter = (Maybe Bool -> Bool -> T.Text)
 
 type Icons = (T.Text, T.Text)
 
-displayIcon :: MonadIO m => Callback -> IconFormatter -> MutableBtState -> m ()
+displayIcon :: Callback -> IconFormatter -> MutableBtState -> IO ()
 displayIcon callback formatter =
-  liftIO . callback . T.unpack . uncurry formatter <=< readState
+  callback . T.unpack . uncurry formatter <=< readState
 
 -- TODO maybe I want this to fail when any of the device statuses are Nothing
 iconFormatter :: Icons -> Colors -> IconFormatter
@@ -136,7 +138,7 @@ emptyState = BtState
   , btPowered = Nothing
   }
 
-readState :: MonadIO m => MutableBtState -> m (Maybe Bool, Bool)
+readState :: MutableBtState -> IO (Maybe Bool, Bool)
 readState state = do
   p <- readPowered state
   c <- readDevices state
@@ -159,55 +161,55 @@ adaptorHasDevice adaptor device = case splitPath device of
 splitPath :: ObjectPath -> [T.Text]
 splitPath = fmap T.pack . splitOn "/" . dropWhile (=='/') . formatObjectPath
 
-getBtObjectTree :: MonadIO m => SysClient -> m ObjectTree
+getBtObjectTree :: SysClient -> IO ObjectTree
 getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
 
 btOMPath :: ObjectPath
 btOMPath = objectPath_ "/"
 
-addBtOMListener :: MonadIO m => SignalCallback -> SysClient -> m ()
-addBtOMListener sc = liftIO . void . addInterfaceAddedListener btBus btOMPath sc
+addBtOMListener :: SignalCallback -> SysClient -> IO ()
+addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
 
-addDeviceAddedListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m ()
-addDeviceAddedListener state dpy adapter client =
+addDeviceAddedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
+addDeviceAddedListener state display adapter client =
   addBtOMListener addDevice client
   where
-    addDevice = pathCallback adapter dpy $ \d ->
-      addAndInitDevice state dpy d client
+    addDevice = pathCallback adapter display $ \d ->
+      addAndInitDevice state display d client
 
-addDeviceRemovedListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m ()
-addDeviceRemovedListener state dpy adapter sys =
+addDeviceRemovedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
+addDeviceRemovedListener state display adapter sys =
   addBtOMListener remDevice sys
   where
-    remDevice = pathCallback adapter dpy $ \d -> do
+    remDevice = pathCallback adapter display $ \d -> do
       old <- removeDevice state d
       forM_ old $ removeMatch (toClient sys) . btDevSigHandler
 
 pathCallback :: ObjectPath -> IO () -> (ObjectPath -> IO ()) -> SignalCallback
-pathCallback adapter dpy f [device, _] = forM_ (fromVariant device) $ \d ->
-  when (adaptorHasDevice adapter d) $ f d >> dpy
+pathCallback adapter display f [device, _] = forM_ (fromVariant device) $ \d ->
+  when (adaptorHasDevice adapter d) $ f d >> display
 pathCallback _ _ _ _ = return ()
 
 --------------------------------------------------------------------------------
 -- | Adapter
 
-initAdapter :: MonadIO m => MutableBtState -> ObjectPath -> SysClient -> m ()
+initAdapter :: MutableBtState -> ObjectPath -> SysClient -> IO ()
 initAdapter state adapter client = do
   reply <- callGetPowered adapter client
-  liftIO $ putPowered state $ fromSingletonVariant reply
+  putPowered state $ fromSingletonVariant reply
 
-matchBTProperty :: MonadIO m => SysClient -> ObjectPath -> m (Maybe MatchRule)
+matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule)
 matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
 
-addAdaptorListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient
-  -> m (Maybe SignalHandler)
-addAdaptorListener state dpy adaptor sys = do
+addAdaptorListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
+  -> IO (Maybe SignalHandler)
+addAdaptorListener state display adaptor sys = do
   rule <- matchBTProperty sys adaptor
   forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) sys
   where
-    procMatch = withSignalMatch $ \b -> liftIO $ putPowered state b >> dpy
+    procMatch = withSignalMatch $ \b -> putPowered state b >> display
 
-callGetPowered :: MonadIO m => ObjectPath -> SysClient -> m [Variant]
+callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
 callGetPowered adapter = callPropertyGet btBus adapter adapterInterface
   $ memberName_ $ T.unpack adaptorPowered
 
@@ -217,7 +219,7 @@ matchPowered = matchPropertyChanged adapterInterface adaptorPowered
 putPowered :: MutableBtState -> Maybe Bool -> IO ()
 putPowered m ds = modifyMVar_ m (\s -> return s { btPowered = ds })
 
-readPowered :: MonadIO m => MutableBtState -> m (Maybe Bool)
+readPowered :: MutableBtState -> IO (Maybe Bool)
 readPowered = fmap btPowered . readMVar
 
 adapterInterface :: InterfaceName
@@ -229,13 +231,13 @@ adaptorPowered = "Powered"
 --------------------------------------------------------------------------------
 -- | Devices
 
-addAndInitDevice :: MonadUnliftIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m ()
-addAndInitDevice state dpy device client = do
-  sh <- addDeviceListener state dpy device client
+addAndInitDevice :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
+addAndInitDevice state display device client = do
+  sh <- addDeviceListener state display device client
   -- TODO add some intelligent error messages here
   forM_ sh $ \s -> initDevice state s device client
 
-initDevice :: MonadUnliftIO m => MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> m ()
+initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO ()
 initDevice state sh device sys = do
   reply <- callGetConnected device sys
   void $ insertDevice state device $
@@ -243,22 +245,22 @@ initDevice state sh device sys = do
              , btDevSigHandler = sh
              }
 
-addDeviceListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient
-  -> m (Maybe SignalHandler)
-addDeviceListener state dpy device sys = do
+addDeviceListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
+  -> IO (Maybe SignalHandler)
+addDeviceListener state display device sys = do
   rule <- matchBTProperty sys device
   forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) sys
   where
-    procMatch = withSignalMatch $ \c -> updateDevice state device c >> dpy
+    procMatch = withSignalMatch $ \c -> updateDevice state device c >> display
 
 matchConnected :: [Variant] -> SignalMatch Bool
 matchConnected = matchPropertyChanged devInterface devConnected
 
-callGetConnected :: MonadIO m => ObjectPath -> SysClient -> m [Variant]
+callGetConnected :: ObjectPath -> SysClient -> IO [Variant]
 callGetConnected p = callPropertyGet btBus p devInterface
   $ memberName_ (T.unpack devConnected)
 
-insertDevice :: MonadUnliftIO m => MutableBtState -> ObjectPath -> BTDevice -> m Bool
+insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool
 insertDevice m device dev = modifyMVar m $ \s -> do
   let new = M.insert device dev $ btDevices s
   return (s { btDevices = new }, anyDevicesConnected new)
@@ -276,7 +278,7 @@ removeDevice m device = modifyMVar m $ \s -> do
   let devs = btDevices s
   return (s { btDevices = M.delete device devs }, M.lookup device devs)
 
-readDevices :: MonadIO m => MutableBtState -> m ConnectedDevices
+readDevices :: MutableBtState -> IO ConnectedDevices
 readDevices = fmap btDevices . readMVar
 
 devInterface :: InterfaceName
diff --git a/lib/Xmobar/Plugins/ClevoKeyboard.hs b/lib/Xmobar/Plugins/ClevoKeyboard.hs
index 67b45f5..92a8f12 100644
--- a/lib/Xmobar/Plugins/ClevoKeyboard.hs
+++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs
@@ -14,6 +14,7 @@ module Xmobar.Plugins.ClevoKeyboard
 import qualified RIO.Text                                      as T
 
 import           Xmobar
+
 import           Xmobar.Plugins.BacklightCommon
 
 import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs
index 45b6eb0..d28ee2b 100644
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@@ -10,17 +10,18 @@ module Xmobar.Plugins.Common
   , Callback
   , Colors(..)
   , displayMaybe
-  , displayMaybe_
+  , displayMaybe'
   , xmobarFGColor
   )
   where
 
+import           Control.Monad
+
 import           Data.Internal.DBus
 
 import           DBus
 import           DBus.Client
 
-import           RIO
 import qualified RIO.Text                as T
 
 import           XMonad.Hooks.DynamicLog (xmobarColor)
@@ -34,21 +35,17 @@ data Colors = Colors
   }
   deriving (Eq, Show, Read)
 
-startListener :: (MonadIO m, SafeClient c, IsVariant a) => MatchRule -> (c -> m [Variant])
+startListener :: (SafeClient c, IsVariant a) => MatchRule -> (c -> IO [Variant])
   -> ([Variant] -> SignalMatch a) -> (a -> IO T.Text) -> Callback
-  -> c -> m ()
+  -> c -> IO ()
 startListener rule getProp fromSignal toColor cb client = do
   reply <- getProp client
-  displayMaybe cb (liftIO . toColor) $ fromSingletonVariant reply
+  displayMaybe cb toColor $ fromSingletonVariant reply
   void $ addMatchCallback rule (procMatch . fromSignal) client
   where
     procMatch = procSignalMatch cb toColor
 
-procSignalMatch
-  :: Callback
-  -> (a -> IO T.Text)
-  -> SignalMatch a
-  -> IO ()
+procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO ()
 procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
 
 colorText :: Colors -> Bool -> T.Text -> T.Text
@@ -61,17 +58,11 @@ xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack
 na :: T.Text
 na = "N/A"
 
-displayMaybe :: (MonadIO m) => Callback -> (a -> m T.Text) -> Maybe a -> m ()
-displayMaybe cb f = (liftIO . cb . T.unpack) <=< maybe (return na) f
+displayMaybe :: Callback -> (a -> IO T.Text) -> Maybe a -> IO ()
+displayMaybe cb f = (cb . T.unpack) <=< maybe (return na) f
 
-displayMaybe_ :: MonadIO m => Callback -> (a -> m ()) -> Maybe a -> m ()
-displayMaybe_ cb = maybe (liftIO $ cb $ T.unpack na)
+displayMaybe' :: Callback -> (a -> IO ()) -> Maybe a -> IO ()
+displayMaybe' cb = maybe (cb $ T.unpack na)
 
-withDBusClientConnection
-  :: (SafeClient c)
-  => Callback
-  -> (c -> RIO SimpleApp ())
-  -> IO ()
-withDBusClientConnection cb f = do
-  -- TODO be more sophisticated
-  runSimpleApp $ withDBusClient_ $ displayMaybe_ cb f . Just
+withDBusClientConnection :: SafeClient c => Callback -> (c -> IO ()) -> IO ()
+withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient
diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index e16db36..13abdb0 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -11,12 +11,14 @@ module Xmobar.Plugins.Device
   , devDep
   ) where
 
+import           Control.Monad
+
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
+import           Data.Word
 
 import           DBus
 
-import           RIO
 import qualified RIO.Text                        as T
 
 import           XMonad.Internal.Command.Desktop
@@ -62,9 +64,9 @@ matchStatus = matchPropertyChanged nmDeviceInterface devSignal
 instance Exec Device where
   alias (Device (iface, _, _)) = T.unpack iface
   start (Device (iface, text, colors)) cb = do
-    withDBusClientConnection cb $ \sys -> liftIO $ do
+    withDBusClientConnection cb $ \sys -> do
       path <- getDevice sys iface
-      displayMaybe_ cb (listener sys) path
+      displayMaybe' cb (listener sys) path
     where
       listener sys path = do
         rule <- matchPropertyFull sys networkManagerBus (Just path)
diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs
index d9f35b3..e60a0fd 100644
--- a/lib/Xmobar/Plugins/IntelBacklight.hs
+++ b/lib/Xmobar/Plugins/IntelBacklight.hs
@@ -14,6 +14,7 @@ module Xmobar.Plugins.IntelBacklight
 import qualified RIO.Text                                       as T
 
 import           Xmobar
+
 import           Xmobar.Plugins.BacklightCommon
 
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs
index c511216..ef125cb 100644
--- a/lib/Xmobar/Plugins/Screensaver.hs
+++ b/lib/Xmobar/Plugins/Screensaver.hs
@@ -11,7 +11,6 @@ module Xmobar.Plugins.Screensaver
   , ssAlias
   ) where
 
-import           RIO
 import qualified RIO.Text                         as T
 
 import           Xmobar
@@ -27,9 +26,9 @@ ssAlias = "screensaver"
 instance Exec Screensaver where
   alias (Screensaver _) = T.unpack ssAlias
   start (Screensaver (text, colors)) cb = do
-    withDBusClientConnection cb $ \sys -> liftIO $ do
-      matchSignal dpy sys
-      dpy =<< callQuery sys
+    withDBusClientConnection cb $ \sys -> do
+      matchSignal display sys
+      display =<< callQuery sys
     where
-      dpy = displayMaybe cb $ return . (\s -> colorText colors s text)
+      display = displayMaybe cb $ return . (\s -> colorText colors s text)
 
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index c617d68..625abf8 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -13,15 +13,17 @@ module Xmobar.Plugins.VPN
   , vpnDep
   ) where
 
+import           Control.Concurrent.MVar
+import           Control.Monad
 
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
+import qualified Data.Map                        as M
+import           Data.Maybe
+import qualified Data.Set                        as S
 
 import           DBus
 
-import           RIO
-import qualified RIO.Map                         as M
-import qualified RIO.Set                         as S
 import qualified RIO.Text                        as T
 
 import           XMonad.Internal.Command.Desktop
@@ -36,11 +38,11 @@ instance Exec VPN where
   start (VPN (text, colors)) cb =
     withDBusClientConnection cb $ \c -> do
     state <- initState c
-    let dpy = displayMaybe cb iconFormatter . Just =<< readState state
-    let signalCallback' f = f state dpy
+    let display = displayMaybe cb iconFormatter . Just =<< readState state
+    let signalCallback' f = f state display
     vpnAddedListener (signalCallback' addedCallback) c
     vpnRemovedListener (signalCallback' removedCallback) c
-    liftIO dpy
+    display
     where
       iconFormatter b = return $ colorText colors b text
 
@@ -55,7 +57,7 @@ type VPNState = S.Set ObjectPath
 
 type MutableVPNState = MVar VPNState
 
-initState :: MonadIO m => SysClient -> m MutableVPNState
+initState :: SysClient -> IO MutableVPNState
 initState client = do
   ot <- getVPNObjectTree client
   newMVar $ findTunnels ot
@@ -63,28 +65,28 @@ initState client = do
 readState :: MutableVPNState -> IO Bool
 readState = fmap (not . null) . readMVar
 
-updateState :: MonadUnliftIO m => (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
-  -> ObjectPath -> m ()
+updateState :: (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
+  -> ObjectPath -> IO ()
 updateState f state op = modifyMVar_ state $ return . f op
 
 --------------------------------------------------------------------------------
 -- | Tunnel Device Detection
 --
 
-getVPNObjectTree :: MonadIO m => SysClient -> m ObjectTree
+getVPNObjectTree :: SysClient -> IO ObjectTree
 getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
 
 findTunnels :: ObjectTree -> VPNState
 findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
 
-vpnAddedListener :: MonadIO m => SignalCallback -> SysClient -> m ()
+vpnAddedListener :: SignalCallback -> SysClient -> IO ()
 vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
 
-vpnRemovedListener :: MonadIO m => SignalCallback -> SysClient -> m ()
+vpnRemovedListener :: SignalCallback -> SysClient -> IO ()
 vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
 
 addedCallback :: MutableVPNState -> IO () -> SignalCallback
-addedCallback state dpy [device, added] = update >> dpy
+addedCallback state display [device, added] = update >> display
   where
     added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant))
     is = M.keys $ fromMaybe M.empty added'
@@ -92,7 +94,7 @@ addedCallback state dpy [device, added] = update >> dpy
 addedCallback _ _ _                       = return ()
 
 removedCallback :: MutableVPNState -> IO () -> SignalCallback
-removedCallback state dpy [device, interfaces] = update >> dpy
+removedCallback state display [device, interfaces] = update >> display
   where
     is = fromMaybe [] $ fromVariant interfaces :: [T.Text]
     update = updateDevice S.delete state device is

From b2b0f72178f53a60624ff43e0c95eb0f6e22a7fb Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 12:21:53 -0500
Subject: [PATCH 027/118] ENH use fourmolu

---
 .stylish-haskell.yaml | 357 ------------------------------------------
 fourmolu.yaml         |  14 ++
 2 files changed, 14 insertions(+), 357 deletions(-)
 delete mode 100644 .stylish-haskell.yaml
 create mode 100644 fourmolu.yaml

diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml
deleted file mode 100644
index 26770c1..0000000
--- a/.stylish-haskell.yaml
+++ /dev/null
@@ -1,357 +0,0 @@
-# stylish-haskell configuration file
-# ==================================
-
-# The stylish-haskell tool is mainly configured by specifying steps. These steps
-# are a list, so they have an order, and one specific step may appear more than
-# once (if needed). Each file is processed by these steps in the given order.
-steps:
-  # Convert some ASCII sequences to their Unicode equivalents. This is disabled
-  # by default.
-  # - unicode_syntax:
-  #     # In order to make this work, we also need to insert the UnicodeSyntax
-  #     # language pragma. If this flag is set to true, we insert it when it's
-  #     # not already present. You may want to disable it if you configure
-  #     # language extensions using some other method than pragmas. Default:
-  #     # true.
-  #     add_language_pragma: true
-
-  # Format module header
-  #
-  # Currently, this option is not configurable and will format all exports and
-  # module declarations to minimize diffs
-  #
-  # - module_header:
-  #     # How many spaces use for indentation in the module header.
-  #     indent: 4
-  #
-  #     # Should export lists be sorted?  Sorting is only performed within the
-  #     # export section, as delineated by Haddock comments.
-  #     sort: true
-  #
-  #     # See `separate_lists` for the `imports` step.
-  #     separate_lists: true
-
-  # Format record definitions. This is disabled by default.
-  #
-  # You can control the layout of record fields. The only rules that can't be configured
-  # are these:
-  #
-  # - "|" is always aligned with "="
-  # - "," in fields is always aligned with "{"
-  # - "}" is likewise always aligned with "{"
-  #
-  # - records:
-  #     # How to format equals sign between type constructor and data constructor.
-  #     # Possible values:
-  #     # - "same_line" -- leave "=" AND data constructor on the same line as the type constructor.
-  #     # - "indent N" -- insert a new line and N spaces from the beginning of the next line.
-  #     equals: "indent 2"
-  #
-  #     # How to format first field of each record constructor.
-  #     # Possible values:
-  #     # - "same_line" -- "{" and first field goes on the same line as the data constructor.
-  #     # - "indent N" -- insert a new line and N spaces from the beginning of the data constructor
-  #     first_field: "indent 2"
-  #
-  #     # How many spaces to insert between the column with "," and the beginning of the comment in the next line.
-  #     field_comment: 2
-  #
-  #     # How many spaces to insert before "deriving" clause. Deriving clauses are always on separate lines.
-  #     deriving: 2
-  #
-  #     # How many spaces to insert before "via" clause counted from indentation of deriving clause
-  #     # Possible values:
-  #     # - "same_line" -- "via" part goes on the same line as "deriving" keyword.
-  #     # - "indent N" -- insert a new line and N spaces from the beginning of "deriving" keyword.
-  #     via: "indent 2"
-  #
-  #     # Sort typeclass names in the "deriving" list alphabetically.
-  #     sort_deriving: true
-  #
-  #     # Wheter or not to break enums onto several lines
-  #     #
-  #     # Default: false
-  #     break_enums: false
-  #
-  #     # Whether or not to break single constructor data types before `=` sign
-  #     #
-  #     # Default: true
-  #     break_single_constructors: true
-  #
-  #     # Whether or not to curry constraints on function.
-  #     #
-  #     # E.g: @allValues :: Enum a => Bounded a => Proxy a -> [a]@
-  #     #
-  #     # Instead of @allValues :: (Enum a, Bounded a) => Proxy a -> [a]@
-  #     #
-  #     # Default: false
-  #     curried_context: false
-
-  # Align the right hand side of some elements.  This is quite conservative
-  # and only applies to statements where each element occupies a single
-  # line.
-  # Possible values:
-  # - always - Always align statements.
-  # - adjacent - Align statements that are on adjacent lines in groups.
-  # - never - Never align statements.
-  # All default to always.
-  - simple_align:
-      cases: always
-      top_level_patterns: always
-      records: always
-      multi_way_if: always
-
-  # Import cleanup
-  - imports:
-      # There are different ways we can align names and lists.
-      #
-      # - global: Align the import names and import list throughout the entire
-      #   file.
-      #
-      # - file: Like global, but don't add padding when there are no qualified
-      #   imports in the file.
-      #
-      # - group: Only align the imports per group (a group is formed by adjacent
-      #   import lines).
-      #
-      # - none: Do not perform any alignment.
-      #
-      # Default: global.
-      align: global
-
-      # The following options affect only import list alignment.
-      #
-      # List align has following options:
-      #
-      # - after_alias: Import list is aligned with end of import including
-      #   'as' and 'hiding' keywords.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #   >                                          init, last, length)
-      #
-      # - with_alias: Import list is aligned with start of alias or hiding.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #   >                                 init, last, length)
-      #
-      # - with_module_name: Import list is aligned `list_padding` spaces after
-      #   the module name.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #                          init, last, length)
-      #
-      #   This is mainly intended for use with `pad_module_names: false`.
-      #
-      #   > import qualified Data.List as List (concat, foldl, foldr, head,
-      #                          init, last, length, scanl, scanr, take, drop,
-      #                          sort, nub)
-      #
-      # - new_line: Import list starts always on new line.
-      #
-      #   > import qualified Data.List      as List
-      #   >     (concat, foldl, foldr, head, init, last, length)
-      #
-      # - repeat: Repeat the module name to align the import list.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head)
-      #   > import qualified Data.List      as List (init, last, length)
-      #
-      # Default: after_alias
-      list_align: after_alias
-
-      # Right-pad the module names to align imports in a group:
-      #
-      # - true: a little more readable
-      #
-      #   > import qualified Data.List       as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #
-      # - false: diff-safe
-      #
-      #   > import qualified Data.List as List (concat, foldl, foldr, init,
-      #   >                                     last, length)
-      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #
-      # Default: true
-      pad_module_names: true
-
-      # Long list align style takes effect when import is too long. This is
-      # determined by 'columns' setting.
-      #
-      # - inline: This option will put as much specs on same line as possible.
-      #
-      # - new_line: Import list will start on new line.
-      #
-      # - new_line_multiline: Import list will start on new line when it's
-      #   short enough to fit to single line. Otherwise it'll be multiline.
-      #
-      # - multiline: One line per import list entry.
-      #   Type with constructor list acts like single import.
-      #
-      #   > import qualified Data.Map as M
-      #   >     ( empty
-      #   >     , singleton
-      #   >     , ...
-      #   >     , delete
-      #   >     )
-      #
-      # Default: inline
-      long_list_align: multiline
-
-      # Align empty list (importing instances)
-      #
-      # Empty list align has following options
-      #
-      # - inherit: inherit list_align setting
-      #
-      # - right_after: () is right after the module name:
-      #
-      #   > import Vector.Instances ()
-      #
-      # Default: inherit
-      empty_list_align: inherit
-
-      # List padding determines indentation of import list on lines after import.
-      # This option affects 'long_list_align'.
-      #
-      # - <integer>: constant value
-      #
-      # - module_name: align under start of module name.
-      #   Useful for 'file' and 'group' align settings.
-      #
-      # Default: 4
-      list_padding: 4
-
-      # Separate lists option affects formatting of import list for type
-      # or class. The only difference is single space between type and list
-      # of constructors, selectors and class functions.
-      #
-      # - true: There is single space between Foldable type and list of it's
-      #   functions.
-      #
-      #   > import Data.Foldable (Foldable (fold, foldl, foldMap))
-      #
-      # - false: There is no space between Foldable type and list of it's
-      #   functions.
-      #
-      #   > import Data.Foldable (Foldable(fold, foldl, foldMap))
-      #
-      # Default: true
-      separate_lists: true
-
-      # Space surround option affects formatting of import lists on a single
-      # line. The only difference is single space after the initial
-      # parenthesis and a single space before the terminal parenthesis.
-      #
-      # - true: There is single space associated with the enclosing
-      #   parenthesis.
-      #
-      #   > import Data.Foo ( foo )
-      #
-      # - false: There is no space associated with the enclosing parenthesis
-      #
-      #   > import Data.Foo (foo)
-      #
-      # Default: false
-      space_surround: false
-
-      # Enabling this argument will use the new GHC lib parse to format imports.
-      #
-      # This currently assumes a few things, it will assume that you want post
-      # qualified imports. It is also not as feature complete as the old
-      # imports formatting.
-      #
-      # It does not remove redundant lines or merge lines. As such, the full
-      # feature scope is still pending.
-      #
-      # It _is_ however, a fine alternative if you are using features that are
-      # not parseable by haskell src extensions and you're comfortable with the
-      # presets.
-      #
-      # Default: false
-      ghc_lib_parser: false
-
-  # Language pragmas
-  - language_pragmas:
-      # We can generate different styles of language pragma lists.
-      #
-      # - vertical: Vertical-spaced language pragmas, one per line.
-      #
-      # - compact: A more compact style.
-      #
-      # - compact_line: Similar to compact, but wrap each line with
-      #   `{-#LANGUAGE #-}'.
-      #
-      # Default: vertical.
-      style: vertical
-
-      # Align affects alignment of closing pragma brackets.
-      #
-      # - true: Brackets are aligned in same column.
-      #
-      # - false: Brackets are not aligned together. There is only one space
-      #   between actual import and closing bracket.
-      #
-      # Default: true
-      align: true
-
-      # stylish-haskell can detect redundancy of some language pragmas. If this
-      # is set to true, it will remove those redundant pragmas. Default: true.
-      remove_redundant: true
-
-      # Language prefix to be used for pragma declaration, this allows you to
-      # use other options non case-sensitive like "language" or "Language".
-      # If a non correct String is provided, it will default to: LANGUAGE.
-      language_prefix: LANGUAGE
-
-  # Replace tabs by spaces. This is disabled by default.
-  # - tabs:
-  #     # Number of spaces to use for each tab. Default: 8, as specified by the
-  #     # Haskell report.
-  #     spaces: 8
-
-  # Remove trailing whitespace
-  - trailing_whitespace: {}
-
-  # Squash multiple spaces between the left and right hand sides of some
-  # elements into single spaces. Basically, this undoes the effect of
-  # simple_align but is a bit less conservative.
-  # - squash: {}
-
-# A common setting is the number of columns (parts of) code will be wrapped
-# to. Different steps take this into account.
-#
-# Set this to null to disable all line wrapping.
-#
-# Default: 80.
-columns: 80
-
-# By default, line endings are converted according to the OS. You can override
-# preferred format here.
-#
-# - native: Native newline format. CRLF on Windows, LF on other OSes.
-#
-# - lf: Convert to LF ("\n").
-#
-# - crlf: Convert to CRLF ("\r\n").
-#
-# Default: native.
-newline: native
-
-# Sometimes, language extensions are specified in a cabal file or from the
-# command line instead of using language pragmas in the file. stylish-haskell
-# needs to be aware of these, so it can parse the file correctly.
-#
-# No language extensions are enabled by default.
-# language_extensions:
-  # - TemplateHaskell
-  # - QuasiQuotes
-
-# Attempt to find the cabal file in ancestors of the current directory, and
-# parse options (currently only language extensions) from that.
-#
-# Default: true
-cabal: true
diff --git a/fourmolu.yaml b/fourmolu.yaml
new file mode 100644
index 0000000..8a4d94e
--- /dev/null
+++ b/fourmolu.yaml
@@ -0,0 +1,14 @@
+indentation: 2
+function-arrows: trailing
+comma-style: leading
+import-export-style: trailing
+indent-wheres: true
+record-brace-space: true
+newlines-between-decls: 1
+haddock-style: single-line
+haddock-style-module:
+let-style: inline
+in-style: right-align
+respectful: false
+fixities: []
+unicode: never

From adf0257533a750b91e6e7076fa6228f030b4a777 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 14:58:23 -0500
Subject: [PATCH 028/118] REF reformat everything with fourmolu

---
 bin/vbox-start.hs                             |  46 +-
 bin/xmobar.hs                                 | 562 ++++++-----
 bin/xmonad.hs                                 | 887 ++++++++++--------
 fourmolu.yaml                                 |   4 +-
 lib/Data/Internal/DBus.hs                     | 193 ++--
 lib/Data/Internal/Dependency.hs               | 691 ++++++++------
 lib/XMonad/Internal/Command/DMenu.hs          | 170 ++--
 lib/XMonad/Internal/Command/Desktop.hs        | 216 +++--
 lib/XMonad/Internal/Command/Power.hs          | 148 +--
 lib/XMonad/Internal/Concurrent/ACPIEvent.hs   |  71 +-
 .../Internal/Concurrent/ClientMessage.hs      |  46 +-
 .../Internal/Concurrent/DynamicWorkspaces.hs  | 179 ++--
 lib/XMonad/Internal/Concurrent/VirtualBox.hs  |  40 +-
 .../Internal/DBus/Brightness/ClevoKeyboard.hs |  66 +-
 lib/XMonad/Internal/DBus/Brightness/Common.hs | 197 ++--
 .../DBus/Brightness/IntelBacklight.hs         |  63 +-
 lib/XMonad/Internal/DBus/Common.hs            |   8 +-
 lib/XMonad/Internal/DBus/Control.hs           |  48 +-
 lib/XMonad/Internal/DBus/Removable.hs         |  50 +-
 lib/XMonad/Internal/DBus/Screensaver.hs       | 118 ++-
 lib/XMonad/Internal/IO.hs                     |  61 +-
 lib/XMonad/Internal/Notify.hs                 |  45 +-
 lib/XMonad/Internal/Process.hs                |  17 -
 lib/XMonad/Internal/Shell.hs                  |  17 +-
 lib/XMonad/Internal/Theme.hs                  | 188 ++--
 lib/Xmobar/Plugins/BacklightCommon.hs         |  33 +-
 lib/Xmobar/Plugins/Bluetooth.hs               | 112 ++-
 lib/Xmobar/Plugins/ClevoKeyboard.hs           |  20 +-
 lib/Xmobar/Plugins/Common.hs                  |  38 +-
 lib/Xmobar/Plugins/Device.hs                  |  49 +-
 lib/Xmobar/Plugins/IntelBacklight.hs          |  20 +-
 lib/Xmobar/Plugins/Screensaver.hs             |  18 +-
 lib/Xmobar/Plugins/VPN.hs                     |  87 +-
 package.yaml                                  |   2 +-
 34 files changed, 2472 insertions(+), 2038 deletions(-)
 delete mode 100644 lib/XMonad/Internal/Process.hs

diff --git a/bin/vbox-start.hs b/bin/vbox-start.hs
index cb82926..c918f38 100644
--- a/bin/vbox-start.hs
+++ b/bin/vbox-start.hs
@@ -1,7 +1,6 @@
-{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
---------------------------------------------------------------------------------
 -- | Start a VirtualBox instance with a sentinel wrapper process.
 --
 -- The only reason why this is needed is because I want to manage virtualboxes
@@ -15,21 +14,16 @@
 -- until its PID exits. By monitoring this wrapper, the dynamic workspace only
 -- has one process to track and will maintain the workspace throughout the
 -- lifetime of the VM.
-
 module Main (main) where
 
-import qualified Data.ByteString.Lazy.UTF8             as BU
-
-import           RIO
-import           RIO.Process
-import qualified RIO.Text                              as T
-
-import           Text.XML.Light
-
-import           System.Environment
-
-import           XMonad.Internal.Concurrent.VirtualBox
-import           XMonad.Internal.IO
+import qualified Data.ByteString.Lazy.UTF8 as BU
+import RIO
+import RIO.Process
+import qualified RIO.Text as T
+import System.Environment
+import Text.XML.Light
+import XMonad.Internal.Concurrent.VirtualBox
+import XMonad.Internal.IO
 
 main :: IO ()
 main = do
@@ -48,7 +42,6 @@ runAndWait [n] = do
       p <- vmPID i
       liftIO $ mapM_ waitUntilExit p
     err = logError "Could not get machine ID"
-
 runAndWait _ = liftIO $ putStrLn "Usage: vbox-start VBOXNAME"
 
 vmLaunch :: T.Text -> RIO SimpleApp ()
@@ -56,25 +49,28 @@ vmLaunch i = do
   rc <- proc "VBoxManage" ["startvm", T.unpack i] runProcess
   case rc of
     ExitSuccess -> return ()
-    _           -> logError $ "Failed to start VM: "
-                   <> displayBytesUtf8 (encodeUtf8 i)
+    _ ->
+      logError $
+        "Failed to start VM: "
+          <> displayBytesUtf8 (encodeUtf8 i)
 
 vmPID :: T.Text -> RIO SimpleApp (Maybe Int)
 vmPID vid = do
   (rc, out) <- proc "pgrep" ["-f", "VirtualBoxVM.*" ++ T.unpack vid] readProcessStdout
   return $ case rc of
     ExitSuccess -> readMaybe $ BU.toString out
-    _           -> Nothing
+    _ -> Nothing
 
 vmMachineID :: FilePath -> RIO SimpleApp (Maybe T.Text)
 vmMachineID iPath = do
   res <- tryAny $ readFileUtf8 iPath
   case res of
     Right contents -> return $ findMachineID contents
-    Left e         -> logError (displayShow e) >> return Nothing
+    Left e -> logError (displayShow e) >> return Nothing
   where
-    findMachineID c = T.stripSuffix "}"
-      =<< T.stripPrefix "{"
-      =<< (fmap T.pack . findAttr (blank_name { qName = "uuid" }))
-      =<< (\e -> findChild (qual e "Machine") e)
-      =<< parseXMLDoc c
+    findMachineID c =
+      T.stripSuffix "}"
+        =<< T.stripPrefix "{"
+        =<< (fmap T.pack . findAttr (blank_name {qName = "uuid"}))
+        =<< (\e -> findChild (qual e "Machine") e)
+        =<< parseXMLDoc c
diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 4a56132..f2621a5 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -1,8 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Main (main) where
-
---------------------------------------------------------------------------------
 -- | Xmobar binary
 --
 -- Features:
@@ -12,52 +9,47 @@ module Main (main) where
 -- * Some custom plugins (imported below)
 -- * Theme integration with xmonad (shared module imported below)
 -- * A custom Locks plugin from my own forked repo
+module Main (main) where
 
-import           Control.Monad
-
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-import           Data.List
-import           Data.Maybe
-
-import           RIO                                            hiding (hFlush)
-import qualified RIO.ByteString.Lazy                            as BL
-import           RIO.Process
-import qualified RIO.Text                                       as T
-
-import           System.Environment
-import           System.IO
-
-import           Xmobar.Plugins.Bluetooth
-import           Xmobar.Plugins.ClevoKeyboard
-import           Xmobar.Plugins.Device
-import           Xmobar.Plugins.IntelBacklight
-import           Xmobar.Plugins.Screensaver
-import           Xmobar.Plugins.VPN
-
-import           XMonad.Core                                    hiding (config)
-import           XMonad.Internal.Command.Desktop
-import           XMonad.Internal.Command.Power
-import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
-import           XMonad.Internal.DBus.Brightness.IntelBacklight
-import           XMonad.Internal.DBus.Control
-import           XMonad.Internal.DBus.Screensaver               (ssSignalDep)
-import qualified XMonad.Internal.Theme                          as XT
-import           Xmobar                                         hiding
-    ( iconOffset
-    , run
-    )
-import           Xmobar.Plugins.Common
-
+import Control.Monad
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import Data.List
+import Data.Maybe
+import RIO hiding (hFlush)
+import qualified RIO.ByteString.Lazy as BL
+import RIO.Process
+import qualified RIO.Text as T
+import System.Environment
+import System.IO
+import XMonad.Core hiding (config)
+import XMonad.Internal.Command.Desktop
+import XMonad.Internal.Command.Power
+import XMonad.Internal.DBus.Brightness.ClevoKeyboard
+import XMonad.Internal.DBus.Brightness.IntelBacklight
+import XMonad.Internal.DBus.Control
+import XMonad.Internal.DBus.Screensaver (ssSignalDep)
+import qualified XMonad.Internal.Theme as XT
+import Xmobar hiding
+  ( iconOffset
+  , run
+  )
+import Xmobar.Plugins.Bluetooth
+import Xmobar.Plugins.ClevoKeyboard
+import Xmobar.Plugins.Common
+import Xmobar.Plugins.Device
+import Xmobar.Plugins.IntelBacklight
+import Xmobar.Plugins.Screensaver
+import Xmobar.Plugins.VPN
 
 main :: IO ()
 main = getArgs >>= parse
 
 parse :: [String] -> IO ()
-parse []         = run
+parse [] = run
 parse ["--deps"] = withCache printDeps
 parse ["--test"] = void $ withCache . evalConfig =<< connectDBus
-parse _          = usage
+parse _ = usage
 
 run :: IO ()
 run = do
@@ -84,13 +76,16 @@ printDeps = do
   io $ disconnectDBus db
 
 usage :: IO ()
-usage = putStrLn $ intercalate "\n"
-  [ "xmobar: run greatest taskbar"
-  , "xmobar --deps: print dependencies"
-  ]
+usage =
+  putStrLn $
+    intercalate
+      "\n"
+      [ "xmobar: run greatest taskbar"
+      , "xmobar --deps: print dependencies"
+      ]
 
 --------------------------------------------------------------------------------
--- | toplevel configuration
+-- toplevel configuration
 
 -- | The text font family
 textFont :: Always XT.FontBuilder
@@ -102,88 +97,93 @@ textFontOffset = 16
 
 -- | Attributes for the bar font (size, weight, etc)
 textFontData :: XT.FontData
-textFontData = XT.defFontData { XT.weight = Just XT.Bold, XT.size = Just 11 }
+textFontData = XT.defFontData {XT.weight = Just XT.Bold, XT.size = Just 11}
 
 -- | The icon font family
 iconFont :: Sometimes XT.FontBuilder
-iconFont = fontSometimes "XMobar Icon Font" "Symbols Nerd Font"
-  [Package Official "ttf-nerd-fonts-symbols-2048-em"]
+iconFont =
+  fontSometimes
+    "XMobar Icon Font"
+    "Symbols Nerd Font"
+    [Package Official "ttf-nerd-fonts-symbols-2048-em"]
 
 -- | Offsets for the icons in the bar (relative to the text offset)
 iconOffset :: BarFont -> Int
-iconOffset IconSmall  = 0
+iconOffset IconSmall = 0
 iconOffset IconMedium = 1
-iconOffset IconLarge  = 1
+iconOffset IconLarge = 1
 iconOffset IconXLarge = 2
 
 -- | Sizes (in pixels) for the icon fonts
 iconSize :: BarFont -> Int
-iconSize IconSmall  = 13
+iconSize IconSmall = 13
 iconSize IconMedium = 15
-iconSize IconLarge  = 18
+iconSize IconLarge = 18
 iconSize IconXLarge = 20
 
 -- | Attributes for icon fonts
 iconFontData :: Int -> XT.FontData
-iconFontData s = XT.defFontData { XT.pixelsize = Just s, XT.size = Nothing }
+iconFontData s = XT.defFontData {XT.pixelsize = Just s, XT.size = Nothing}
 
 -- | Global configuration
 -- Note that the 'font' and 'textOffset' are assumed to pertain to one (and
 -- only one) text font, and all other fonts are icon fonts. If this assumption
 -- changes the code will need to change significantly
 config :: T.Text -> [T.Text] -> [Int] -> BarRegions -> FilePath -> Config
-config bf ifs ios br confDir = defaultConfig
-  { font = T.unpack bf
-  , additionalFonts = fmap T.unpack ifs
-  , textOffset = textFontOffset
-  , textOffsets = ios
-  , bgColor = T.unpack XT.bgColor
-  , fgColor = T.unpack XT.fgColor
-  , position = BottomSize C 100 24
-  , border = NoBorder
-  , borderColor = T.unpack XT.bordersColor
-
-  , sepChar = T.unpack pSep
-  , alignSep = [lSep, rSep]
-  , template = T.unpack $ fmtRegions br
-
-  , lowerOnStart = False
-  , hideOnStart = False
-  , allDesktops = True
-  , overrideRedirect = True
-  , pickBroadest = False
-  , persistent = True
-  -- store the icons with the xmonad/xmobar stack project
-  , iconRoot = confDir ++ "/icons"
-
-  , commands = csRunnable <$> concatRegions br
-  }
+config bf ifs ios br confDir =
+  defaultConfig
+    { font = T.unpack bf
+    , additionalFonts = fmap T.unpack ifs
+    , textOffset = textFontOffset
+    , textOffsets = ios
+    , bgColor = T.unpack XT.bgColor
+    , fgColor = T.unpack XT.fgColor
+    , position = BottomSize C 100 24
+    , border = NoBorder
+    , borderColor = T.unpack XT.bordersColor
+    , sepChar = T.unpack pSep
+    , alignSep = [lSep, rSep]
+    , template = T.unpack $ fmtRegions br
+    , lowerOnStart = False
+    , hideOnStart = False
+    , allDesktops = True
+    , overrideRedirect = True
+    , pickBroadest = False
+    , persistent = True
+    , -- store the icons with the xmonad/xmobar stack project
+      iconRoot = confDir ++ "/icons"
+    , commands = csRunnable <$> concatRegions br
+    }
 
 --------------------------------------------------------------------------------
--- | plugin features
+--  plugin features
 --
 -- some commands depend on the presence of interfaces that can only be
 -- determined at runtime; define these checks here
 
 getAllCommands :: [Maybe CmdSpec] -> BarRegions
-getAllCommands right = BarRegions
-  { brLeft = [ CmdSpec
-               { csAlias = "UnsafeStdinReader"
-               , csRunnable = Run UnsafeStdinReader
-               }
-             ]
-  , brCenter = []
-  , brRight = catMaybes right
-  }
+getAllCommands right =
+  BarRegions
+    { brLeft =
+        [ CmdSpec
+            { csAlias = "UnsafeStdinReader"
+            , csRunnable = Run UnsafeStdinReader
+            }
+        ]
+    , brCenter = []
+    , brRight = catMaybes right
+    }
 
 rightPlugins :: DBusState -> FIO [Maybe CmdSpec]
-rightPlugins db = mapM evalFeature $ allFeatures db
-  ++ [always' "date indicator" dateCmd]
+rightPlugins db =
+  mapM evalFeature $
+    allFeatures db
+      ++ [always' "date indicator" dateCmd]
   where
     always' n = Right . Always n . Always_ . FallbackAlone
 
 allFeatures :: DBusState -> [Feature CmdSpec]
-allFeatures DBusState { dbSesClient = ses, dbSysClient = sys } =
+allFeatures DBusState {dbSesClient = ses, dbSysClient = sys} =
   [ Left getWireless
   , Left $ getEthernet sys
   , Left $ getVPN sys
@@ -200,8 +200,11 @@ type BarFeature = Sometimes CmdSpec
 
 -- TODO what if I don't have a wireless card?
 getWireless :: BarFeature
-getWireless = Sometimes "wireless status indicator" xpfWireless
-  [Subfeature (IORoot wirelessCmd $ Only readWireless) "sysfs path"]
+getWireless =
+  Sometimes
+    "wireless status indicator"
+    xpfWireless
+    [Subfeature (IORoot wirelessCmd $ Only readWireless) "sysfs path"]
 
 getEthernet :: Maybe SysClient -> BarFeature
 getEthernet cl = iconDBus "ethernet status indicator" xpfEthernet root tree
@@ -213,32 +216,49 @@ getBattery :: BarFeature
 getBattery = iconIO_ "battery level indicator" xpfBattery root tree
   where
     root useIcon = IORoot_ (batteryCmd useIcon)
-    tree = Only_ $ IOTest_ "Test if battery is present" []
-      $ io $ fmap (Msg LevelError) <$> hasBattery
+    tree =
+      Only_ $
+        IOTest_ "Test if battery is present" [] $
+          io $
+            fmap (Msg LevelError) <$> hasBattery
 
 getVPN :: Maybe SysClient -> BarFeature
 getVPN cl = iconDBus_ "VPN status indicator" xpfVPN root $ toAnd_ vpnDep test
   where
     root useIcon tree = DBusRoot_ (const $ vpnCmd useIcon) tree cl
-    test = DBusIO $ IOTest_ "Use nmcli to test if VPN is present"
-      networkManagerPkgs vpnPresent
+    test =
+      DBusIO $
+        IOTest_
+          "Use nmcli to test if VPN is present"
+          networkManagerPkgs
+          vpnPresent
 
 getBt :: Maybe SysClient -> BarFeature
 getBt = xmobarDBus "bluetooth status indicator" xpfBluetooth btDep btCmd
 
 getAlsa :: BarFeature
-getAlsa = iconIO_ "volume level indicator" (const True) root
-  $ Only_ $ sysExe [Package Official "alsa-utils"] "alsactl"
+getAlsa =
+  iconIO_ "volume level indicator" (const True) root $
+    Only_ $
+      sysExe [Package Official "alsa-utils"] "alsactl"
   where
     root useIcon = IORoot_ (alsaCmd useIcon)
 
 getBl :: Maybe SesClient -> BarFeature
-getBl = xmobarDBus "Intel backlight indicator" xpfIntelBacklight
-  intelBacklightSignalDep blCmd
+getBl =
+  xmobarDBus
+    "Intel backlight indicator"
+    xpfIntelBacklight
+    intelBacklightSignalDep
+    blCmd
 
 getCk :: Maybe SesClient -> BarFeature
-getCk = xmobarDBus "Clevo keyboard indicator" xpfClevoBacklight
-  clevoKeyboardSignalDep ckCmd
+getCk =
+  xmobarDBus
+    "Clevo keyboard indicator"
+    xpfClevoBacklight
+    clevoKeyboardSignalDep
+    ckCmd
 
 getSs :: Maybe SesClient -> BarFeature
 getSs = xmobarDBus "screensaver indicator" (const True) ssSignalDep ssCmd
@@ -249,158 +269,232 @@ getLock = always1 "lock indicator" "icon indicator" root $ lockCmd fontifyAlt
     root = IORoot_ (lockCmd fontifyIcon) $ Only_ iconDependency
 
 --------------------------------------------------------------------------------
--- | bar feature constructors
+-- bar feature constructors
 
-xmobarDBus :: SafeClient c => T.Text -> XPQuery -> DBusDependency_ c
-  -> (Fontifier -> CmdSpec) -> Maybe c -> BarFeature
+xmobarDBus
+  :: SafeClient c
+  => T.Text
+  -> XPQuery
+  -> DBusDependency_ c
+  -> (Fontifier -> CmdSpec)
+  -> Maybe c
+  -> BarFeature
 xmobarDBus n q dep cmd cl = iconDBus_ n q root (Only_ dep)
   where
     root useIcon tree = DBusRoot_ (const $ cmd useIcon) tree cl
 
-iconIO_ :: T.Text -> XPQuery -> (Fontifier -> IOTree_ -> Root CmdSpec)
-  -> IOTree_ -> BarFeature
+iconIO_
+  :: T.Text
+  -> XPQuery
+  -> (Fontifier -> IOTree_ -> Root CmdSpec)
+  -> IOTree_
+  -> BarFeature
 iconIO_ = iconSometimes' And_ Only_
 
-iconDBus :: SafeClient c => T.Text -> XPQuery
-  -> (Fontifier -> DBusTree c p -> Root CmdSpec) -> DBusTree c p -> BarFeature
+iconDBus
+  :: SafeClient c
+  => T.Text
+  -> XPQuery
+  -> (Fontifier -> DBusTree c p -> Root CmdSpec)
+  -> DBusTree c p
+  -> BarFeature
 iconDBus = iconSometimes' And1 $ Only_ . DBusIO
 
-iconDBus_ :: SafeClient c => T.Text -> XPQuery
-  -> (Fontifier -> DBusTree_ c -> Root CmdSpec) -> DBusTree_ c -> BarFeature
+iconDBus_
+  :: SafeClient c
+  => T.Text
+  -> XPQuery
+  -> (Fontifier -> DBusTree_ c -> Root CmdSpec)
+  -> DBusTree_ c
+  -> BarFeature
 iconDBus_ = iconSometimes' And_ $ Only_ . DBusIO
 
-iconSometimes' :: (t -> t_ -> t) -> (IODependency_ -> t_) -> T.Text -> XPQuery
-  -> (Fontifier -> t -> Root CmdSpec) -> t -> BarFeature
-iconSometimes' c d n q r t = Sometimes n q
-  [ Subfeature icon "icon indicator"
-  , Subfeature text "text indicator"
-  ]
+iconSometimes'
+  :: (t -> t_ -> t)
+  -> (IODependency_ -> t_)
+  -> T.Text
+  -> XPQuery
+  -> (Fontifier -> t -> Root CmdSpec)
+  -> t
+  -> BarFeature
+iconSometimes' c d n q r t =
+  Sometimes
+    n
+    q
+    [ Subfeature icon "icon indicator"
+    , Subfeature text "text indicator"
+    ]
   where
     icon = r fontifyIcon $ c t $ d iconDependency
     text = r fontifyAlt t
 
 --------------------------------------------------------------------------------
--- | command specifications
+-- command specifications
 
 data BarRegions = BarRegions
-  { brLeft   :: [CmdSpec]
+  { brLeft :: [CmdSpec]
   , brCenter :: [CmdSpec]
-  , brRight  :: [CmdSpec]
-  } deriving Show
+  , brRight :: [CmdSpec]
+  }
+  deriving (Show)
 
 data CmdSpec = CmdSpec
-  { csAlias    :: T.Text
+  { csAlias :: T.Text
   , csRunnable :: Runnable
-  } deriving Show
+  }
+  deriving (Show)
 
 concatRegions :: BarRegions -> [CmdSpec]
 concatRegions (BarRegions l c r) = l ++ c ++ r
 
 wirelessCmd :: T.Text -> CmdSpec
-wirelessCmd iface = CmdSpec
-  { csAlias = T.append iface "wi"
-  , csRunnable = Run $ Wireless (T.unpack iface) args 5
-  }
+wirelessCmd iface =
+  CmdSpec
+    { csAlias = T.append iface "wi"
+    , csRunnable = Run $ Wireless (T.unpack iface) args 5
+    }
   where
-    args = fmap T.unpack
-      [ "-t", "<qualityipat><essid>"
-      , "--"
-      , "--quality-icon-pattern", "<icon=wifi_%%.xpm/>"
-      ]
+    args =
+      fmap
+        T.unpack
+        [ "-t"
+        , "<qualityipat><essid>"
+        , "--"
+        , "--quality-icon-pattern"
+        , "<icon=wifi_%%.xpm/>"
+        ]
 
 ethernetCmd :: Fontifier -> T.Text -> CmdSpec
-ethernetCmd fontify iface = CmdSpec
-  { csAlias = iface
-  , csRunnable = Run
-    $ Device (iface, fontify IconMedium "\xf0e8" "ETH", colors)
-  }
+ethernetCmd fontify iface =
+  CmdSpec
+    { csAlias = iface
+    , csRunnable =
+        Run $
+          Device (iface, fontify IconMedium "\xf0e8" "ETH", colors)
+    }
 
 batteryCmd :: Fontifier -> CmdSpec
-batteryCmd fontify = CmdSpec
-  { csAlias = "battery"
-  , csRunnable = Run $ Battery args 50
-  }
+batteryCmd fontify =
+  CmdSpec
+    { csAlias = "battery"
+    , csRunnable = Run $ Battery args 50
+    }
   where
     fontify' = fontify IconSmall
-    args = fmap T.unpack
-      [ "--template", "<acstatus><left>"
-      , "--Low", "10"
-      , "--High", "80"
-      , "--low", "red"
-      , "--normal", XT.fgColor
-      , "--high", XT.fgColor
-      , "--"
-      , "-P"
-      , "-o" , fontify' "\xf0e7" "BAT"
-      , "-O" , fontify' "\xf1e6" "AC"
-      , "-i" , fontify' "\xf1e6" "AC"
-      ]
+    args =
+      fmap
+        T.unpack
+        [ "--template"
+        , "<acstatus><left>"
+        , "--Low"
+        , "10"
+        , "--High"
+        , "80"
+        , "--low"
+        , "red"
+        , "--normal"
+        , XT.fgColor
+        , "--high"
+        , XT.fgColor
+        , "--"
+        , "-P"
+        , "-o"
+        , fontify' "\xf0e7" "BAT"
+        , "-O"
+        , fontify' "\xf1e6" "AC"
+        , "-i"
+        , fontify' "\xf1e6" "AC"
+        ]
 
 vpnCmd :: Fontifier -> CmdSpec
-vpnCmd fontify = CmdSpec
-  { csAlias = vpnAlias
-  , csRunnable = Run $ VPN (fontify IconMedium "\xf023" "VPN", colors)
-  }
+vpnCmd fontify =
+  CmdSpec
+    { csAlias = vpnAlias
+    , csRunnable = Run $ VPN (fontify IconMedium "\xf023" "VPN", colors)
+    }
 
 btCmd :: Fontifier -> CmdSpec
-btCmd fontify = CmdSpec
-  { csAlias = btAlias
-  , csRunnable = Run
-    $ Bluetooth (fontify' "\xf5b0" "+", fontify' "\xf5ae" "-") colors
-  }
+btCmd fontify =
+  CmdSpec
+    { csAlias = btAlias
+    , csRunnable =
+        Run $
+          Bluetooth (fontify' "\xf5b0" "+", fontify' "\xf5ae" "-") colors
+    }
   where
     fontify' i = fontify IconLarge i . T.append "BT"
 
 alsaCmd :: Fontifier -> CmdSpec
-alsaCmd fontify = CmdSpec
-  { csAlias = "alsa:default:Master"
-  , csRunnable = Run
-    $ Alsa "default" "Master"
-    $ fmap T.unpack
-    [ "-t", "<status><volume>%"
-    , "--"
-    , "-O", fontify' "\xf028" "+"
-    , "-o", T.append (fontify' "\xf026" "-") " "
-    , "-c", XT.fgColor
-    , "-C", XT.fgColor
-    ]
-  }
+alsaCmd fontify =
+  CmdSpec
+    { csAlias = "alsa:default:Master"
+    , csRunnable =
+        Run $
+          Alsa "default" "Master" $
+            fmap
+              T.unpack
+              [ "-t"
+              , "<status><volume>%"
+              , "--"
+              , "-O"
+              , fontify' "\xf028" "+"
+              , "-o"
+              , T.append (fontify' "\xf026" "-") " "
+              , "-c"
+              , XT.fgColor
+              , "-C"
+              , XT.fgColor
+              ]
+    }
   where
     fontify' i = fontify IconSmall i . T.append "VOL"
 
 blCmd :: Fontifier -> CmdSpec
-blCmd fontify = CmdSpec
-  { csAlias = blAlias
-  , csRunnable = Run $ IntelBacklight $ fontify IconSmall "\xf185" "BL: "
-  }
+blCmd fontify =
+  CmdSpec
+    { csAlias = blAlias
+    , csRunnable = Run $ IntelBacklight $ fontify IconSmall "\xf185" "BL: "
+    }
 
 ckCmd :: Fontifier -> CmdSpec
-ckCmd fontify = CmdSpec
-  { csAlias = ckAlias
-  , csRunnable = Run $ ClevoKeyboard $ fontify IconSmall "\xf40b" "KB: "
-  }
+ckCmd fontify =
+  CmdSpec
+    { csAlias = ckAlias
+    , csRunnable = Run $ ClevoKeyboard $ fontify IconSmall "\xf40b" "KB: "
+    }
 
 ssCmd :: Fontifier -> CmdSpec
-ssCmd fontify = CmdSpec
-  { csAlias = ssAlias
-  , csRunnable = Run $ Screensaver (fontify IconSmall "\xf254" "SS", colors)
-  }
+ssCmd fontify =
+  CmdSpec
+    { csAlias = ssAlias
+    , csRunnable = Run $ Screensaver (fontify IconSmall "\xf254" "SS", colors)
+    }
 
 lockCmd :: Fontifier -> CmdSpec
-lockCmd fontify = CmdSpec
-  { csAlias = "locks"
-  , csRunnable = Run
-    $ Locks
-    $ fmap T.unpack
-    [ "-N", numIcon
-    , "-n", disabledColor numIcon
-    , "-C", capIcon
-    , "-c", disabledColor capIcon
-    , "-s", ""
-    , "-S", ""
-    , "-d", " "
-    ]
-  }
+lockCmd fontify =
+  CmdSpec
+    { csAlias = "locks"
+    , csRunnable =
+        Run $
+          Locks $
+            fmap
+              T.unpack
+              [ "-N"
+              , numIcon
+              , "-n"
+              , disabledColor numIcon
+              , "-C"
+              , capIcon
+              , "-c"
+              , disabledColor capIcon
+              , "-s"
+              , ""
+              , "-S"
+              , ""
+              , "-d"
+              , " "
+              ]
+    }
   where
     numIcon = fontify' "\xf8a5" "N"
     capIcon = fontify' "\xf657" "C"
@@ -408,33 +502,37 @@ lockCmd fontify = CmdSpec
     disabledColor = xmobarFGColor XT.backdropFgColor
 
 dateCmd :: CmdSpec
-dateCmd = CmdSpec
-  { csAlias = "date"
-  , csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
-  }
+dateCmd =
+  CmdSpec
+    { csAlias = "date"
+    , csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
+    }
 
 --------------------------------------------------------------------------------
--- | low-level testing functions
+-- low-level testing functions
 
 vpnPresent :: FIO (Maybe Msg)
 vpnPresent = do
   res <- proc "nmcli" args readProcess
   return $ case res of
-    (ExitSuccess, out, _) | "vpn" `elem` BL.split 10 out -> Nothing
-                          | otherwise -> Just $ Msg LevelError "vpn not found"
-    (ExitFailure c, _, err) -> Just $ Msg LevelError
-                               $ T.concat
-                               ["vpn search exited with code "
-                               , T.pack $ show c
-                               , ": "
-                               , T.decodeUtf8With T.lenientDecode
-                                 $ BL.toStrict err
-                               ]
+    (ExitSuccess, out, _)
+      | "vpn" `elem` BL.split 10 out -> Nothing
+      | otherwise -> Just $ Msg LevelError "vpn not found"
+    (ExitFailure c, _, err) ->
+      Just $
+        Msg LevelError $
+          T.concat
+            [ "vpn search exited with code "
+            , T.pack $ show c
+            , ": "
+            , T.decodeUtf8With T.lenientDecode $
+                BL.toStrict err
+            ]
   where
     args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
 
 --------------------------------------------------------------------------------
--- | text font
+-- text font
 --
 -- ASSUME there is only one text font for this entire configuration. This
 -- will correspond to the first font/offset parameters in the config record.
@@ -445,17 +543,20 @@ getTextFont = do
   return $ fb textFontData
 
 --------------------------------------------------------------------------------
--- | icon fonts
+-- icon fonts
 
 getIconFonts :: FIO ([T.Text], [Int])
 getIconFonts = do
   fb <- evalSometimes iconFont
   return $ maybe ([], []) apply fb
   where
-    apply fb = unzip $ (\i -> (iconString fb i, iconOffset i + textFontOffset))
-      <$> iconFonts
+    apply fb =
+      unzip $
+        (\i -> (iconString fb i, iconOffset i + textFontOffset))
+          <$> iconFonts
 
-data BarFont = IconSmall
+data BarFont
+  = IconSmall
   | IconMedium
   | IconLarge
   | IconXLarge
@@ -483,10 +584,10 @@ fontifyIcon :: Fontifier
 fontifyIcon f i _ = fontifyText f i
 
 --------------------------------------------------------------------------------
--- | various formatting things
+-- various formatting things
 
 colors :: Colors
-colors = Colors { colorsOn = XT.fgColor, colorsOff = XT.backdropFgColor }
+colors = Colors {colorsOn = XT.fgColor, colorsOff = XT.backdropFgColor}
 
 sep :: T.Text
 sep = xmobarFGColor XT.backdropFgColor " : "
@@ -503,8 +604,9 @@ pSep = "%"
 fmtSpecs :: [CmdSpec] -> T.Text
 fmtSpecs = T.intercalate sep . fmap go
   where
-    go CmdSpec { csAlias = a } = T.concat [pSep, a, pSep]
+    go CmdSpec {csAlias = a} = T.concat [pSep, a, pSep]
 
 fmtRegions :: BarRegions -> T.Text
-fmtRegions BarRegions { brLeft = l, brCenter = c, brRight = r } = T.concat
-  [fmtSpecs l, T.singleton lSep, fmtSpecs c, T.singleton rSep, fmtSpecs r]
+fmtRegions BarRegions {brLeft = l, brCenter = c, brRight = r} =
+  T.concat
+    [fmtSpecs l, T.singleton lSep, fmtSpecs c, T.singleton rSep, fmtSpecs r]
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 316b242..5bd7d16 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -1,84 +1,79 @@
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | XMonad binary
+--  XMonad binary
 
 module Main (main) where
 
-import           Control.Monad
-
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-import           Data.List
-import           Data.Maybe
-import           Data.Monoid
-import           Data.Text.IO                                   (hPutStrLn)
-
-import           Graphics.X11.Types
-import           Graphics.X11.Xlib.Atom
-import           Graphics.X11.Xlib.Extras
-
-import           RIO
-import           RIO.Directory
-import           RIO.Process
-import qualified RIO.Text                                       as T
-
-import           System.Environment
-import           System.Posix.Signals
-import           System.Process
-    ( getPid
-    , getProcessExitCode
-    )
-
-import           XMonad
-import           XMonad.Actions.CopyWindow
-import           XMonad.Actions.CycleWS
-import           XMonad.Actions.PhysicalScreens
-import           XMonad.Actions.Warp
-import           XMonad.Hooks.DynamicLog
-import           XMonad.Hooks.EwmhDesktops
-import           XMonad.Hooks.ManageDocks
-import           XMonad.Hooks.ManageHelpers
-import           XMonad.Internal.Command.DMenu
-import           XMonad.Internal.Command.Desktop
-import           XMonad.Internal.Command.Power
-import           XMonad.Internal.Concurrent.ACPIEvent
-import           XMonad.Internal.Concurrent.ClientMessage
-import           XMonad.Internal.Concurrent.DynamicWorkspaces
-import           XMonad.Internal.Concurrent.VirtualBox
-import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
-import           XMonad.Internal.DBus.Brightness.Common
-import           XMonad.Internal.DBus.Brightness.IntelBacklight
-import           XMonad.Internal.DBus.Control
-import           XMonad.Internal.DBus.Removable
-import           XMonad.Internal.DBus.Screensaver
-import           XMonad.Internal.Shell                          hiding (proc)
-import qualified XMonad.Internal.Theme                          as XT
-import           XMonad.Layout.MultiToggle
-import           XMonad.Layout.NoBorders
-import           XMonad.Layout.NoFrillsDecoration
-import           XMonad.Layout.PerWorkspace
-import           XMonad.Layout.Renamed
-import           XMonad.Layout.Tabbed
-import qualified XMonad.Operations                              as O
-import qualified XMonad.StackSet                                as W
-import           XMonad.Util.Cursor
-import           XMonad.Util.EZConfig
-import qualified XMonad.Util.ExtensibleState                    as E
-import           XMonad.Util.NamedActions
-import           XMonad.Util.WorkspaceCompare
+import Control.Monad
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Data.Text.IO (hPutStrLn)
+import Graphics.X11.Types
+import Graphics.X11.Xlib.Atom
+import Graphics.X11.Xlib.Extras
+import RIO
+import RIO.Directory
+import RIO.Process
+import qualified RIO.Text as T
+import System.Environment
+import System.Posix.Signals
+import System.Process
+  ( getPid
+  , getProcessExitCode
+  )
+import XMonad
+import XMonad.Actions.CopyWindow
+import XMonad.Actions.CycleWS
+import XMonad.Actions.PhysicalScreens
+import XMonad.Actions.Warp
+import XMonad.Hooks.DynamicLog
+import XMonad.Hooks.EwmhDesktops
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
+import XMonad.Internal.Command.DMenu
+import XMonad.Internal.Command.Desktop
+import XMonad.Internal.Command.Power
+import XMonad.Internal.Concurrent.ACPIEvent
+import XMonad.Internal.Concurrent.ClientMessage
+import XMonad.Internal.Concurrent.DynamicWorkspaces
+import XMonad.Internal.Concurrent.VirtualBox
+import XMonad.Internal.DBus.Brightness.ClevoKeyboard
+import XMonad.Internal.DBus.Brightness.Common
+import XMonad.Internal.DBus.Brightness.IntelBacklight
+import XMonad.Internal.DBus.Control
+import XMonad.Internal.DBus.Removable
+import XMonad.Internal.DBus.Screensaver
+import XMonad.Internal.Shell hiding (proc)
+import qualified XMonad.Internal.Theme as XT
+import XMonad.Layout.MultiToggle
+import XMonad.Layout.NoBorders
+import XMonad.Layout.NoFrillsDecoration
+import XMonad.Layout.PerWorkspace
+import XMonad.Layout.Renamed
+import XMonad.Layout.Tabbed
+import qualified XMonad.Operations as O
+import qualified XMonad.StackSet as W
+import XMonad.Util.Cursor
+import XMonad.Util.EZConfig
+import qualified XMonad.Util.ExtensibleState as E
+import XMonad.Util.NamedActions
+import XMonad.Util.WorkspaceCompare
 
 main :: IO ()
 main = getArgs >>= parse
 
 parse :: [String] -> IO ()
-parse []         = run
+parse [] = run
 parse ["--deps"] = withCache printDeps
 -- parse ["--test"] = void $ withCache . evalConf =<< connectDBusX
-parse _          = usage
+parse _ = usage
 
 run :: IO ()
 run = do
@@ -110,26 +105,31 @@ run = do
           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
-                      }
+          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
-    startRemovableMon db fs = void $ executeSometimes $ fsRemovableMon fs
-                        $ dbSysClient db
+    startRemovableMon db fs =
+      void $
+        executeSometimes $
+          fsRemovableMon fs $
+            dbSysClient db
     startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
     startDynWorkspaces fs = do
       dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
@@ -142,8 +142,9 @@ runXMonad conf = do
   launch conf dirs
 
 startDBusInterfaces :: DBusState -> FeatureSet -> FIO ()
-startDBusInterfaces db fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
-  $ fsDBusExporters fs
+startDBusInterfaces db fs =
+  mapM_ (\f -> executeSometimes $ f $ dbSesClient db) $
+    fsDBusExporters fs
 
 getCreateDirectories :: IO Directories
 getCreateDirectories = do
@@ -156,18 +157,18 @@ getCreateDirectories = do
       r <- tryIO $ createDirectoryIfMissing True d
       case r of
         (Left e) -> print e
-        _        -> return ()
+        _ -> return ()
 
 data FeatureSet = FeatureSet
-  { fsKeys          :: ThreadState -> DBusState -> [KeyGroup FeatureX]
+  { fsKeys :: ThreadState -> DBusState -> [KeyGroup FeatureX]
   , fsDBusExporters :: [Maybe SesClient -> SometimesIO]
-  , fsPowerMon      :: SometimesIO
-  , fsRemovableMon  :: Maybe SysClient -> SometimesIO
-  , fsDaemons       :: [Sometimes (FIO (Process () () ()))]
-  , fsACPIHandler   :: Always (String -> X ())
-  , fsTabbedTheme   :: Always Theme
+  , fsPowerMon :: SometimesIO
+  , fsRemovableMon :: Maybe SysClient -> SometimesIO
+  , fsDaemons :: [Sometimes (FIO (Process () () ()))]
+  , fsACPIHandler :: Always (String -> X ())
+  , fsTabbedTheme :: Always Theme
   , fsDynWorkspaces :: [Sometimes DynWorkspace]
-  , fsShowKeys      :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
+  , fsShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
   }
 
 tabbedFeature :: Always Theme
@@ -178,17 +179,18 @@ tabbedFeature = Always "theme for tabbed windows" $ Option sf fallback
     fallback = Always_ $ FallbackAlone $ XT.tabbedTheme XT.fallbackFont
 
 features :: Maybe SysClient -> FeatureSet
-features cl = FeatureSet
-  { fsKeys = externalBindings
-  , fsDBusExporters = dbusExporters
-  , fsPowerMon = runPowermon
-  , fsRemovableMon = runRemovableMon
-  , fsACPIHandler = runHandleACPI
-  , fsDynWorkspaces = allDWs'
-  , fsTabbedTheme = tabbedFeature
-  , fsShowKeys = runShowKeys
-  , fsDaemons = [runNetAppDaemon cl, runAutolock]
-  }
+features cl =
+  FeatureSet
+    { fsKeys = externalBindings
+    , fsDBusExporters = dbusExporters
+    , fsPowerMon = runPowermon
+    , fsRemovableMon = runRemovableMon
+    , fsACPIHandler = runHandleACPI
+    , fsDynWorkspaces = allDWs'
+    , fsTabbedTheme = tabbedFeature
+    , fsShowKeys = runShowKeys
+    , fsDaemons = [runNetAppDaemon cl, runAutolock]
+    }
 
 startXmobar :: FIO (Process Handle () ())
 startXmobar = do
@@ -196,9 +198,10 @@ startXmobar = do
   io $ hSetBuffering (getStdin p) LineBuffering
   return p
   where
-    start = startProcess
-      . setStdin createPipe
-      . setCreateGroup True
+    start =
+      startProcess
+        . setStdin createPipe
+        . setCreateGroup True
 
 startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
@@ -228,37 +231,42 @@ printDeps :: FIO ()
 printDeps = do
   db <- io connectDBus
   (i, f, d) <- allFeatures db
-  io $ mapM_ (putStrLn . T.unpack)
-    $ fmap showFulfillment
-    $ sort
-    $ nub
-    $ concat
-    $ fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
+  io $
+    mapM_ (putStrLn . T.unpack) $
+      fmap showFulfillment $
+        sort $
+          nub $
+            concat $
+              fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
   io $ disconnectDBus db
 
 allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
 allFeatures db = do
-  let bfs = concatMap (fmap kbMaybeAction . kgBindings)
-            $ externalBindings ts db
+  let bfs =
+        concatMap (fmap kbMaybeAction . kgBindings) $
+          externalBindings ts db
   let dbus = fmap (\f -> f $ dbSesClient db) dbusExporters
   let others = [runRemovableMon $ dbSysClient db, runPowermon]
-  return (dbus ++ others, Left runScreenLock:bfs, allDWs')
+  return (dbus ++ others, Left runScreenLock : bfs, allDWs')
   where
-    ts = ThreadState { tsChildPIDs = [], tsXmobar = Nothing }
+    ts = ThreadState {tsChildPIDs = [], tsXmobar = Nothing}
 
 usage :: IO ()
-usage = putStrLn $ intercalate "\n"
-  [ "xmonad: run greatest window manager"
-  , "xmonad --deps: print dependencies"
-  ]
+usage =
+  putStrLn $
+    intercalate
+      "\n"
+      [ "xmonad: run greatest window manager"
+      , "xmonad --deps: print dependencies"
+      ]
 
 --------------------------------------------------------------------------------
--- | Concurrency configuration
+-- Concurrency configuration
 
 data ThreadState = ThreadState
-    { tsChildPIDs :: [Process () () ()]
-    , tsXmobar    :: Maybe (Process Handle () ())
-    }
+  { tsChildPIDs :: [Process () () ()]
+  , tsXmobar :: Maybe (Process Handle () ())
+  }
 
 runCleanup :: ThreadState -> DBusState -> X ()
 runCleanup ts db = io $ do
@@ -294,18 +302,19 @@ killNoWait p = do
     handleIO (\_ -> return ()) $ stopProcess p
 
 --------------------------------------------------------------------------------
--- | Startuphook configuration
+-- Startuphook configuration
 
 -- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED?
 myStartupHook :: X ()
-myStartupHook = setDefaultCursor xC_left_ptr
-  <+> startupHook def
+myStartupHook =
+  setDefaultCursor xC_left_ptr
+    <+> startupHook def
 
 --------------------------------------------------------------------------------
--- | Workspace configuration
+-- Workspace configuration
 
 myWorkspaces :: [WorkspaceId]
-myWorkspaces = map show [1..10 :: Int]
+myWorkspaces = map show [1 .. 10 :: Int]
 
 gimpTag :: String
 gimpTag = "GIMP"
@@ -323,122 +332,148 @@ gimpDynamicWorkspace :: Sometimes DynWorkspace
 gimpDynamicWorkspace = sometimesIO_ "gimp workspace" "gimp" tree dw
   where
     tree = Only_ $ sysExe [Package Official "gimp"] exe
-    dw = DynWorkspace
-         { dwName = "Gimp"
-         , dwTag = gimpTag
-         , dwClass = c
-         , dwHook =
-           [ matchGimpRole "gimp-image-window" -?> appendViewShift gimpTag
-           , matchGimpRole "gimp-dock" -?> doF W.swapDown
-           , matchGimpRole "gimp-toolbox" -?> doF W.swapDown
-           , className =? c -?> appendViewShift gimpTag
-           ]
-         , dwKey = 'g'
-         , dwCmd = Just $ spawnCmd exe []
-         }
+    dw =
+      DynWorkspace
+        { dwName = "Gimp"
+        , dwTag = gimpTag
+        , dwClass = c
+        , dwHook =
+            [ matchGimpRole "gimp-image-window" -?> appendViewShift gimpTag
+            , matchGimpRole "gimp-dock" -?> doF W.swapDown
+            , matchGimpRole "gimp-toolbox" -?> doF W.swapDown
+            , className =? c -?> appendViewShift gimpTag
+            ]
+        , dwKey = 'g'
+        , dwCmd = Just $ spawnCmd exe []
+        }
     exe = "gimp-2.10"
-    matchGimpRole role = isPrefixOf role <$> stringProperty "WM_WINDOW_ROLE"
-      <&&> className =? c
+    matchGimpRole role =
+      isPrefixOf role
+        <$> stringProperty "WM_WINDOW_ROLE"
+        <&&> className
+        =? c
     c = "Gimp-2.10" -- TODO I don't feel like changing the version long term
 
 -- TODO don't hardcode the VM name/title/shortcut
 vmDynamicWorkspace :: Sometimes DynWorkspace
-vmDynamicWorkspace = Sometimes "virtualbox workspace" xpfVirtualBox
-  [Subfeature root "windows 8 VM"]
+vmDynamicWorkspace =
+  Sometimes
+    "virtualbox workspace"
+    xpfVirtualBox
+    [Subfeature root "windows 8 VM"]
   where
-    root = IORoot_ dw $ toAnd_ (sysExe [Package Official "virtualbox"] "VBoxManage")
-      $ IOTest_ name [] $ io $ vmExists vm
+    root =
+      IORoot_ dw $
+        toAnd_ (sysExe [Package Official "virtualbox"] "VBoxManage") $
+          IOTest_ name [] $
+            io $
+              vmExists vm
     name = T.unwords ["test if", vm, "exists"]
     c = "VirtualBoxVM"
     vm = "win8raw"
-    dw = DynWorkspace
-         { dwName = "Windows VirtualBox"
-         , dwTag = vmTag
-         , dwClass = c
-         , dwHook = [ className =? c -?> appendViewShift vmTag ]
-         , dwKey = 'v'
-         , dwCmd = Just $ spawnCmd "vbox-start" [vm]
-         }
+    dw =
+      DynWorkspace
+        { dwName = "Windows VirtualBox"
+        , dwTag = vmTag
+        , dwClass = c
+        , dwHook = [className =? c -?> appendViewShift vmTag]
+        , dwKey = 'v'
+        , dwCmd = Just $ spawnCmd "vbox-start" [vm]
+        }
 
 xsaneDynamicWorkspace :: Sometimes DynWorkspace
-xsaneDynamicWorkspace = Sometimes "scanner workspace" xpfXSANE
-  [Subfeature (IORoot_ dw tree) "xsane"]
+xsaneDynamicWorkspace =
+  Sometimes
+    "scanner workspace"
+    xpfXSANE
+    [Subfeature (IORoot_ dw tree) "xsane"]
   where
     tree = Only_ $ sysExe [Package Official "xsane"] "xsane"
-    dw = DynWorkspace
-         { dwName = "XSane"
-         , dwTag = xsaneTag
-         , dwClass = c
-         , dwHook = [ className =? c -?> appendViewShift xsaneTag >> doFloat ]
-         , dwKey = 'x'
-         , dwCmd = Just $ spawnCmd "xsane" []
-         }
+    dw =
+      DynWorkspace
+        { dwName = "XSane"
+        , dwTag = xsaneTag
+        , dwClass = c
+        , dwHook = [className =? c -?> appendViewShift xsaneTag >> doFloat]
+        , dwKey = 'x'
+        , dwCmd = Just $ spawnCmd "xsane" []
+        }
     c = "Xsane"
 
 f5vpnDynamicWorkspace :: Sometimes DynWorkspace
-f5vpnDynamicWorkspace = Sometimes "F5 VPN workspace" xpfF5VPN
-  [Subfeature (IORoot_ dw tree) "f5vpn"]
+f5vpnDynamicWorkspace =
+  Sometimes
+    "F5 VPN workspace"
+    xpfF5VPN
+    [Subfeature (IORoot_ dw tree) "f5vpn"]
   where
     tree = Only_ $ sysExe [Package AUR "f5vpn"] "f5vpn"
-    dw = DynWorkspace
-         { dwName = "F5Vpn"
-         , dwTag = f5Tag
-         , dwClass = c
-         , dwHook = [ className =? c -?> appendShift f5Tag ]
-         , dwKey = 'i'
-         , dwCmd = Just skip
-         }
+    dw =
+      DynWorkspace
+        { dwName = "F5Vpn"
+        , dwTag = f5Tag
+        , dwClass = c
+        , dwHook = [className =? c -?> appendShift f5Tag]
+        , dwKey = 'i'
+        , dwCmd = Just skip
+        }
     c = "F5 VPN"
 
 allDWs' :: [Sometimes DynWorkspace]
-allDWs' = [xsaneDynamicWorkspace
-          , vmDynamicWorkspace
-          , gimpDynamicWorkspace
-          , f5vpnDynamicWorkspace
-          ]
+allDWs' =
+  [ xsaneDynamicWorkspace
+  , vmDynamicWorkspace
+  , gimpDynamicWorkspace
+  , f5vpnDynamicWorkspace
+  ]
 
 --------------------------------------------------------------------------------
--- | Layout configuration
+-- Layout configuration
 
 -- NOTE this will have all available layouts, even those that may be for
 -- features that failed. Trying to dynamically take out a layout seems to
 -- make a new type :/
-myLayouts tt = onWorkspace vmTag vmLayout
-  $ onWorkspace gimpTag gimpLayout
-  $ mkToggle (single HIDE)
-  $ tall ||| fulltab ||| full
+myLayouts tt =
+  onWorkspace vmTag vmLayout $
+    onWorkspace gimpTag gimpLayout $
+      mkToggle (single HIDE) $
+        tall ||| fulltab ||| full
   where
     addTopBar = noFrillsDeco shrinkText tt
-    tall = renamed [Replace "Tall"]
-      $ avoidStruts
-      $ addTopBar
-      $ noBorders
-      $ Tall 1 0.03 0.5
-    fulltab = renamed [Replace "Tabbed"]
-      $ avoidStruts
-      $ noBorders
-      $ tabbedAlways shrinkText tt
-    full = renamed [Replace "Full"]
-      $ noBorders Full
+    tall =
+      renamed [Replace "Tall"] $
+        avoidStruts $
+          addTopBar $
+            noBorders $
+              Tall 1 0.03 0.5
+    fulltab =
+      renamed [Replace "Tabbed"] $
+        avoidStruts $
+          noBorders $
+            tabbedAlways shrinkText tt
+    full =
+      renamed [Replace "Full"] $
+        noBorders Full
     vmLayout = noBorders Full
     -- TODO use a tabbed layout for multiple master windows
-    gimpLayout = renamed [Replace "Gimp Layout"]
-      $ avoidStruts
-      $ noBorders
-      $ addTopBar
-      $ Tall 1 0.025 0.8
+    gimpLayout =
+      renamed [Replace "Gimp Layout"] $
+        avoidStruts $
+          noBorders $
+            addTopBar $
+              Tall 1 0.025 0.8
 
 -- | Make a new empty layout and add a message to show/hide it. This is useful
 -- for quickly showing conky.
 data EmptyLayout a = EmptyLayout
-    deriving (Show, Read)
+  deriving (Show, Read)
 
 instance LayoutClass EmptyLayout a where
   doLayout a b _ = emptyLayout a b
   description _ = "Desktop"
 
 data HIDE = HIDE
-    deriving (Read, Show, Eq, Typeable)
+  deriving (Read, Show, Eq, Typeable)
 
 instance Transformer HIDE Window where
   transform _ x k = k EmptyLayout (\EmptyLayout -> x)
@@ -448,8 +483,7 @@ runHide :: X ()
 runHide = sendMessage $ Toggle HIDE
 
 --------------------------------------------------------------------------------
--- | Loghook configuration
---
+-- Loghook configuration
 
 myLoghook :: Process Handle () () -> X ()
 myLoghook h = do
@@ -467,10 +501,10 @@ myLoghook h = do
 -- _NET_DESKTOP_VIEWPORT, but for now there seems to be no ill effects so why
 -- bother...(if that were necessary it would go in the startup hook)
 newtype DesktopViewports = DesktopViewports [Int]
-    deriving Eq
+  deriving (Eq)
 
 instance ExtensionClass DesktopViewports where
-    initialValue = DesktopViewports []
+  initialValue = DesktopViewports []
 
 logViewports :: X ()
 logViewports = withWindowSet $ \s -> do
@@ -478,28 +512,29 @@ logViewports = withWindowSet $ \s -> do
   let ws = sort' $ W.workspaces s
   let desktopViewports = concatMap (wsToViewports s) ws
   whenChanged (DesktopViewports desktopViewports) $
-      setDesktopViewports desktopViewports
+    setDesktopViewports desktopViewports
   where
-    wsToViewports s w = let cur = W.current s in
-      if W.tag w == currentTag cur then currentPos cur else [0, 0]
+    wsToViewports s w =
+      let cur = W.current s
+       in if W.tag w == currentTag cur then currentPos cur else [0, 0]
     currentTag = W.tag . W.workspace
     currentPos = rectXY . screenRect . W.screenDetail
     rectXY (Rectangle x y _ _) = [fromIntegral x, fromIntegral y]
 
 setDesktopViewports :: [Int] -> X ()
 setDesktopViewports vps = withDisplay $ \dpy -> do
-    r <- asks theRoot
-    a <- getAtom "_NET_DESKTOP_VIEWPORT"
-    c <- getAtom "CARDINAL"
-    io $ changeProperty32 dpy r a c propModeReplace $ map fromIntegral vps
+  r <- asks theRoot
+  a <- getAtom "_NET_DESKTOP_VIEWPORT"
+  c <- getAtom "CARDINAL"
+  io $ changeProperty32 dpy r a c propModeReplace $ map fromIntegral vps
 
 -- stolen from XMonad.Hooks.EwmhDesktops
 whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
 whenChanged v action = do
-    v0 <- E.get
-    unless (v == v0) $ do
-        action
-        E.put v
+  v0 <- E.get
+  unless (v == v0) $ do
+    action
+    E.put v
 
 -- | Xinerama loghook (for xmobar)
 -- The format will be like "[<1> 2 3] 4 5 | LAYOUT (N)" where each digit is the
@@ -507,156 +542,174 @@ whenChanged v action = do
 -- currently visible and the order reflects the physical location of each
 -- screen. The "<>" is the workspace that currently has focus. N is the number
 -- of windows on the current workspace.
-
 logXinerama :: Process Handle () () -> X ()
-logXinerama p = withWindowSet $ \ws -> io
-  $ hPutStrLn (getStdin p)
-  $ T.unwords
-  $ filter (not . T.null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws]
+logXinerama p = withWindowSet $ \ws ->
+  io $
+    hPutStrLn (getStdin p) $
+      T.unwords $
+        filter (not . T.null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws]
   where
-    onScreen ws = xmobarColor_ hilightFgColor hilightBgColor
-      $ (T.pack . pad . T.unpack)
-      $ T.unwords
-      $ map (fmtTags ws . W.tag . W.workspace)
-      $ sortBy compareXCoord
-      $ W.current ws : W.visible ws
-    offScreen = xmobarColor_ XT.backdropFgColor ""
-      . T.unwords
-      . fmap (T.pack . W.tag)
-      . filter (isJust . W.stack)
-      . sortOn W.tag
-      . W.hidden
+    onScreen ws =
+      xmobarColor_ hilightFgColor hilightBgColor $
+        (T.pack . pad . T.unpack) $
+          T.unwords $
+            map (fmtTags ws . W.tag . W.workspace) $
+              sortBy compareXCoord $
+                W.current ws : W.visible ws
+    offScreen =
+      xmobarColor_ XT.backdropFgColor ""
+        . T.unwords
+        . fmap (T.pack . W.tag)
+        . filter (isJust . W.stack)
+        . sortOn W.tag
+        . W.hidden
     sep = xmobarColor_ XT.backdropFgColor "" ":"
     layout = T.pack . description . W.layout . W.workspace . W.current
-    nWindows = (\x -> T.concat ["(", x, ")"])
-      . T.pack
-      . show
-      . length
-      . W.integrate'
-      . W.stack
-      . W.workspace
-      . W.current
+    nWindows =
+      (\x -> T.concat ["(", x, ")"])
+        . T.pack
+        . show
+        . length
+        . W.integrate'
+        . W.stack
+        . W.workspace
+        . W.current
     hilightBgColor = "#A6D3FF"
     hilightFgColor = XT.blend' 0.4 hilightBgColor XT.fgColor
-    fmtTags ws t = let t_ = T.pack t in
-      if t == W.currentTag ws
-      then xmobarColor_ XT.fgColor hilightBgColor t_
-      else t_
+    fmtTags ws t =
+      let t_ = T.pack t
+       in if t == W.currentTag ws
+            then xmobarColor_ XT.fgColor hilightBgColor t_
+            else t_
     xmobarColor_ a b c = T.pack $ xmobarColor (T.unpack a) (T.unpack b) (T.unpack c)
 
 compareXCoord
   :: W.Screen i1 l1 a1 ScreenId ScreenDetail
-     -> W.Screen i2 l2 a2 ScreenId ScreenDetail -> Ordering
+  -> W.Screen i2 l2 a2 ScreenId ScreenDetail
+  -> Ordering
 compareXCoord s0 s1 = compare (go s0) (go s1)
   where
     go = (\(Rectangle x _ _ _) -> x) . snd . getScreenIdAndRectangle
 
 --------------------------------------------------------------------------------
--- | Managehook configuration
+-- Managehook configuration
 
 myManageHook :: [DynWorkspace] -> ManageHook
 myManageHook dws = manageApps dws <+> manageHook def
 
 manageApps :: [DynWorkspace] -> ManageHook
-manageApps dws = composeOne $ concatMap dwHook dws ++
-  [ isDialog -?> doCenterFloat
-  -- the seafile applet
-  , className =? "Seafile Client" -?> doFloat
-  -- gnucash
-  , (className =? "Gnucash" <&&> title =? "Transaction Import Assistant") -?> doFloat
-  -- plots and graphics
-  , className =? "R_x11" -?> doFloat
-  , className =? "Matplotlib" -?> doFloat
-  , className =? "mpv"    -?> doFloat
-  -- the floating windows created by the brave browser
-  , stringProperty "WM_NAME" =? "Brave" -?> doFloat
-  -- , (stringProperty "WM_WINDOW_ROLE" =? "pop-up"
-  --    <&&> className =? "Brave-browser") -?> doFloat
-  -- the dialog windows created by the zotero addon in Google Docs
-  , (className =? "Zotero" <&&> resource =? "Toplevel") -?> doFloat
-  ]
+manageApps dws =
+  composeOne $
+    concatMap dwHook dws
+      ++ [ isDialog -?> doCenterFloat
+         , -- the seafile applet
+           className =? "Seafile Client" -?> doFloat
+         , -- gnucash
+           (className =? "Gnucash" <&&> title =? "Transaction Import Assistant") -?> doFloat
+         , -- plots and graphics
+           className =? "R_x11" -?> doFloat
+         , className =? "Matplotlib" -?> doFloat
+         , className =? "mpv" -?> doFloat
+         , -- the floating windows created by the brave browser
+           stringProperty "WM_NAME" =? "Brave" -?> doFloat
+         , -- , (stringProperty "WM_WINDOW_ROLE" =? "pop-up"
+           --    <&&> className =? "Brave-browser") -?> doFloat
+           -- the dialog windows created by the zotero addon in Google Docs
+           (className =? "Zotero" <&&> resource =? "Toplevel") -?> doFloat
+         ]
 
 --------------------------------------------------------------------------------
--- | Eventhook configuration
+-- Eventhook configuration
 
 myEventHook :: (String -> X ()) -> Event -> X All
 myEventHook handler = xMsgEventHook handler <+> handleEventHook def
 
 -- | React to ClientMessage events from concurrent threads
 xMsgEventHook :: (String -> X ()) -> Event -> X All
-xMsgEventHook handler ClientMessageEvent { ev_message_type = t, ev_data = d }
+xMsgEventHook handler ClientMessageEvent {ev_message_type = t, ev_data = d}
   | t == bITMAP = do
-    let (xtype, tag) = splitXMsg d
-    case xtype of
-      Workspace -> removeDynamicWorkspace tag
-      ACPI      -> handler tag
-      Unknown   -> io $ putStrLn "WARNING: unknown concurrent message"
-    return (All True)
+      let (xtype, tag) = splitXMsg d
+      case xtype of
+        Workspace -> removeDynamicWorkspace tag
+        ACPI -> handler tag
+        Unknown -> io $ putStrLn "WARNING: unknown concurrent message"
+      return (All True)
 xMsgEventHook _ _ = return (All True)
 
 --------------------------------------------------------------------------------
--- | Keymap configuration
+-- Keymap configuration
 
 myModMask :: KeyMask
 myModMask = mod4Mask
 
-addKeymap :: [DynWorkspace] -> ([((KeyMask, KeySym), NamedAction)] -> X ())
-  -> [KeyGroup (X ())] -> XConfig l -> XConfig l
-addKeymap dws showKeys external = addDescrKeys' ((myModMask, xK_F1), showKeys)
-  (\c -> concatMap (mkNamedSubmap c) $ internalBindings dws c ++ external)
+addKeymap
+  :: [DynWorkspace]
+  -> ([((KeyMask, KeySym), NamedAction)] -> X ())
+  -> [KeyGroup (X ())]
+  -> XConfig l
+  -> XConfig l
+addKeymap dws showKeys external =
+  addDescrKeys'
+    ((myModMask, xK_F1), showKeys)
+    (\c -> concatMap (mkNamedSubmap c) $ internalBindings dws c ++ external)
 
 internalBindings :: [DynWorkspace] -> XConfig Layout -> [KeyGroup (X ())]
 internalBindings dws c =
-  [ KeyGroup "Window Layouts"
-    [ KeyBinding "M-j" "focus down" $ windows W.focusDown
-    , KeyBinding "M-k" "focus up" $ windows W.focusUp
-    , KeyBinding "M-m" "focus master" $ windows W.focusMaster
-    , KeyBinding "M-d" "focus master" runHide
-    , KeyBinding "M-S-j" "swap down" $ windows W.swapDown
-    , KeyBinding "M-S-k" "swap up" $ windows W.swapUp
-    , KeyBinding "M-S-m" "swap master" $ windows W.swapMaster
-    , KeyBinding "M-<Return>" "next layout" $ sendMessage NextLayout
-    , KeyBinding "M-S-<Return>" "reset layout" $ setLayout $ layoutHook c
-    , KeyBinding "M-t" "sink tiling" $ withFocused $ windows . W.sink
-    , KeyBinding "M-S-t" "float tiling" $ withFocused O.float
-    , KeyBinding "M--" "shrink" $ sendMessage Shrink
-    , KeyBinding "M-=" "expand" $ sendMessage Expand
-    , KeyBinding "M-S--" "remove master window" $ sendMessage $ IncMasterN (-1)
-    , KeyBinding "M-S-=" "add master window" $ sendMessage $ IncMasterN 1
-    ]
-
-  , KeyGroup "Workspaces"
-    -- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get
-    -- valid keysyms)
-    ([ KeyBinding (mods ++ n) (msg ++ n) (f n) | n <- myWorkspaces
-      , (mods, msg, f) <-
-        [ ("M-", "switch to workspace ", windows . W.view)
-        , ("M-S-", "move client to workspace ", windows . W.shift)
-        , ("M-C-", "follow client to workspace ", \n' -> do
-              windows $ W.shift n'
-              windows $ W.view n')
+  [ KeyGroup
+      "Window Layouts"
+      [ KeyBinding "M-j" "focus down" $ windows W.focusDown
+      , KeyBinding "M-k" "focus up" $ windows W.focusUp
+      , KeyBinding "M-m" "focus master" $ windows W.focusMaster
+      , KeyBinding "M-d" "focus master" runHide
+      , KeyBinding "M-S-j" "swap down" $ windows W.swapDown
+      , KeyBinding "M-S-k" "swap up" $ windows W.swapUp
+      , KeyBinding "M-S-m" "swap master" $ windows W.swapMaster
+      , KeyBinding "M-<Return>" "next layout" $ sendMessage NextLayout
+      , KeyBinding "M-S-<Return>" "reset layout" $ setLayout $ layoutHook c
+      , KeyBinding "M-t" "sink tiling" $ withFocused $ windows . W.sink
+      , KeyBinding "M-S-t" "float tiling" $ withFocused O.float
+      , KeyBinding "M--" "shrink" $ sendMessage Shrink
+      , KeyBinding "M-=" "expand" $ sendMessage Expand
+      , KeyBinding "M-S--" "remove master window" $ sendMessage $ IncMasterN (-1)
+      , KeyBinding "M-S-=" "add master window" $ sendMessage $ IncMasterN 1
+      ]
+  , KeyGroup
+      "Workspaces"
+      -- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get
+      -- valid keysyms)
+      ( [ KeyBinding (mods ++ n) (msg ++ n) (f n) | n <- myWorkspaces, (mods, msg, f) <-
+                                                                        [ ("M-", "switch to workspace ", windows . W.view)
+                                                                        , ("M-S-", "move client to workspace ", windows . W.shift)
+                                                                        ,
+                                                                          ( "M-C-"
+                                                                          , "follow client to workspace "
+                                                                          , \n' -> do
+                                                                              windows $ W.shift n'
+                                                                              windows $ W.view n'
+                                                                          )
+                                                                        ]
         ]
-     ] ++
-     [ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next (hiddenWS :&: Not emptyWS)
-     , KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev (hiddenWS :&: Not emptyWS)
-     ])
-
-  , KeyGroup "Dynamic Workspaces"
-    [ KeyBinding ("M-C-" ++ [k]) ("launch/switch to " ++ n) cmd
-    |  DynWorkspace { dwTag = t, dwKey = k, dwCmd = a, dwName = n } <- dws,
-       let cmd = case a of
-             Just a' -> spawnOrSwitch t a'
-             Nothing -> windows $ W.view t
-    ]
-
-  , KeyGroup "Screens"
-    [ KeyBinding "M-l" "move up screen" nextScr
-    , KeyBinding "M-h" "move down screen" prevScr
-    , KeyBinding "M-C-l" "follow client up screen" $ nextScr' W.shift
-    , KeyBinding "M-C-h" "follow client down screen" $ prevScr' W.shift
-    , KeyBinding "M-S-l" "shift workspace up screen" $ nextScr' W.greedyView
-    , KeyBinding "M-S-h" "shift workspace down screen" $ prevScr' W.greedyView
-    ]
+          ++ [ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next (hiddenWS :&: Not emptyWS)
+             , KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev (hiddenWS :&: Not emptyWS)
+             ]
+      )
+  , KeyGroup
+      "Dynamic Workspaces"
+      [ KeyBinding ("M-C-" ++ [k]) ("launch/switch to " ++ n) cmd
+      | DynWorkspace {dwTag = t, dwKey = k, dwCmd = a, dwName = n} <- dws
+      , let cmd = case a of
+              Just a' -> spawnOrSwitch t a'
+              Nothing -> windows $ W.view t
+      ]
+  , KeyGroup
+      "Screens"
+      [ KeyBinding "M-l" "move up screen" nextScr
+      , KeyBinding "M-h" "move down screen" prevScr
+      , KeyBinding "M-C-l" "follow client up screen" $ nextScr' W.shift
+      , KeyBinding "M-C-h" "follow client down screen" $ prevScr' W.shift
+      , KeyBinding "M-S-l" "shift workspace up screen" $ nextScr' W.greedyView
+      , KeyBinding "M-S-h" "shift workspace down screen" $ prevScr' W.greedyView
+      ]
   ]
   where
     prev = onPrevNeighbour horizontalScreenOrderer
@@ -666,110 +719,114 @@ internalBindings dws c =
     prevScr' f = prev f >> prevScr
     nextScr' f = next f >> nextScr
 
-mkNamedSubmap :: XConfig Layout ->  KeyGroup (X ()) -> [((KeyMask, KeySym), NamedAction)]
-mkNamedSubmap c KeyGroup { kgHeader = h, kgBindings = b } =
-  (subtitle h:) $ mkNamedKeymap c
-  $ (\KeyBinding{kbSyms = s, kbDesc = d, kbMaybeAction = a} -> (s, addName d a))
-  <$> b
+mkNamedSubmap :: XConfig Layout -> KeyGroup (X ()) -> [((KeyMask, KeySym), NamedAction)]
+mkNamedSubmap c KeyGroup {kgHeader = h, kgBindings = b} =
+  (subtitle h :) $
+    mkNamedKeymap c $
+      (\KeyBinding {kbSyms = s, kbDesc = d, kbMaybeAction = a} -> (s, addName d a))
+        <$> b
 
 data KeyBinding a = KeyBinding
-  { kbSyms        :: String
-  , kbDesc        :: String
+  { kbSyms :: String
+  , kbDesc :: String
   , kbMaybeAction :: a
   }
 
 data KeyGroup a = KeyGroup
-  { kgHeader   :: String
+  { kgHeader :: String
   , kgBindings :: [KeyBinding a]
   }
 
 evalExternal :: [KeyGroup FeatureX] -> FIO [KeyGroup MaybeX]
 evalExternal = mapM go
   where
-    go k@KeyGroup { kgBindings = bs } =
-      (\bs' -> k { kgBindings = bs' }) <$> mapM evalKeyBinding bs
+    go k@KeyGroup {kgBindings = bs} =
+      (\bs' -> k {kgBindings = bs'}) <$> mapM evalKeyBinding bs
 
 evalKeyBinding :: KeyBinding FeatureX -> FIO (KeyBinding MaybeX)
-evalKeyBinding k@KeyBinding { kbMaybeAction = a } =
-  (\f -> k { kbMaybeAction = f }) <$> evalFeature a
+evalKeyBinding k@KeyBinding {kbMaybeAction = a} =
+  (\f -> k {kbMaybeAction = f}) <$> evalFeature a
 
 filterExternal :: [KeyGroup MaybeX] -> [KeyGroup (X ())]
 filterExternal = fmap go
   where
-    go k@KeyGroup { kgBindings = bs } =
-      k { kgBindings = [ kb { kbMaybeAction = x }
-                       | kb@KeyBinding { kbMaybeAction = Just x } <- bs
-                       ]
+    go k@KeyGroup {kgBindings = bs} =
+      k
+        { kgBindings =
+            [ kb {kbMaybeAction = x}
+            | kb@KeyBinding {kbMaybeAction = Just x} <- bs
+            ]
         }
 
 externalBindings :: ThreadState -> DBusState -> [KeyGroup FeatureX]
 externalBindings ts db =
-  [ KeyGroup "Launchers"
-    [ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu
-    , KeyBinding "M-g" "launch clipboard manager" $ Left runClipMenu
-    , KeyBinding "M-a" "launch network selector" $ Left $ runNetMenu sys
-    , KeyBinding "M-w" "launch window selector" $ Left runWinMenu
-    , KeyBinding "M-u" "launch device selector" $ Left runDevMenu
-    , KeyBinding "M-b" "launch bitwarden selector" $ Left $ runBwMenu ses
-    , KeyBinding "M-v" "launch ExpressVPN selector" $ Left runVPNMenu
-    , KeyBinding "M-e" "launch bluetooth selector" $ Left runBTMenu
-    , KeyBinding "M-C-e" "launch editor" $ Left runEditor
-    , KeyBinding "M-C-w" "launch browser" $ Left runBrowser
-    , KeyBinding "M-C-t" "launch terminal with tmux" $ Left runTMux
-    , KeyBinding "M-C-S-t" "launch terminal" $ Left runTerm
-    , KeyBinding "M-C-q" "launch calc" $ Left runCalc
-    , KeyBinding "M-C-f" "launch file manager" $ Left runFileManager
-    ]
-
-  , KeyGroup "Actions"
-    [ KeyBinding "M-q" "close window" $ ftrAlways "kill window function" kill1
-    , KeyBinding "M-r" "run program" $ Left runCmdMenu
-    , KeyBinding "M-<Space>" "warp pointer" $ ftrAlways "warp function" $ warpToWindow 0.5 0.5
-    , KeyBinding "M-C-s" "capture area" $ Left $ runAreaCapture ses
-    , KeyBinding "M-C-S-s" "capture screen" $ Left $ runScreenCapture ses
-    , KeyBinding "M-C-d" "capture desktop" $ Left $ runDesktopCapture ses
-    , KeyBinding "M-C-b" "browse captures" $ Left runCaptureBrowser
-    -- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
-    ]
-
-  , KeyGroup "Multimedia"
-    [ KeyBinding "<XF86AudioPlay>" "toggle play/pause" $ Left runTogglePlay
-    , KeyBinding "<XF86AudioPrev>" "previous track" $ Left runPrevTrack
-    , KeyBinding "<XF86AudioNext>" "next track" $ Left runNextTrack
-    , KeyBinding "<XF86AudioStop>" "stop" $ Left runStopPlay
-    , KeyBinding "<XF86AudioLowerVolume>" "volume down" $ Left runVolumeDown
-    , KeyBinding "<XF86AudioRaiseVolume>" "volume up" $ Left runVolumeUp
-    , KeyBinding "<XF86AudioMute>" "volume mute" $ Left runVolumeMute
-    ]
-
-  , KeyGroup "Dunst"
-    [ KeyBinding "M-`" "dunst history" $ Left $ runNotificationHistory ses
-    , KeyBinding "M-S-`" "dunst close" $ Left $ runNotificationClose ses
-    , KeyBinding "M-M1-`" "dunst context menu" $ Left $ runNotificationContext ses
-    , KeyBinding "M-C-`" "dunst close all" $ Left $ runNotificationCloseAll ses
-    ]
-
-  , KeyGroup "System"
-    [ KeyBinding "M-." "backlight up" $ ib bctlInc
-    , KeyBinding "M-," "backlight down" $ ib bctlDec
-    , KeyBinding "M-M1-," "backlight min" $ ib bctlMin
-    , KeyBinding "M-M1-." "backlight max" $ ib bctlMax
-    , KeyBinding "M-S-." "keyboard up" $ ck bctlInc
-    , KeyBinding "M-S-," "keyboard down" $ ck bctlDec
-    , KeyBinding "M-S-M1-," "keyboard min" $ ck bctlMin
-    , KeyBinding "M-S-M1-." "keyboard max" $ ck bctlMax
-    , KeyBinding "M-<End>" "power menu" $ Left runPowerPrompt
-    , KeyBinding "M-<Home>" "quit xmonad" $ Left runQuitPrompt
-    , KeyBinding "M-<Delete>" "lock screen" $ Left runScreenLock
-    -- M-<F1> reserved for showing the keymap
-    , KeyBinding "M-<F2>" "restart xmonad" restartf
-    , KeyBinding "M-<F3>" "recompile xmonad" recompilef
-    , KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
-    , KeyBinding "M-<F9>" "toggle ethernet" $ Left runToggleEthernet
-    , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ runToggleBluetooth sys
-    , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ callToggle ses
-    , KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt
-    ]
+  [ KeyGroup
+      "Launchers"
+      [ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu
+      , KeyBinding "M-g" "launch clipboard manager" $ Left runClipMenu
+      , KeyBinding "M-a" "launch network selector" $ Left $ runNetMenu sys
+      , KeyBinding "M-w" "launch window selector" $ Left runWinMenu
+      , KeyBinding "M-u" "launch device selector" $ Left runDevMenu
+      , KeyBinding "M-b" "launch bitwarden selector" $ Left $ runBwMenu ses
+      , KeyBinding "M-v" "launch ExpressVPN selector" $ Left runVPNMenu
+      , KeyBinding "M-e" "launch bluetooth selector" $ Left runBTMenu
+      , KeyBinding "M-C-e" "launch editor" $ Left runEditor
+      , KeyBinding "M-C-w" "launch browser" $ Left runBrowser
+      , KeyBinding "M-C-t" "launch terminal with tmux" $ Left runTMux
+      , KeyBinding "M-C-S-t" "launch terminal" $ Left runTerm
+      , KeyBinding "M-C-q" "launch calc" $ Left runCalc
+      , KeyBinding "M-C-f" "launch file manager" $ Left runFileManager
+      ]
+  , KeyGroup
+      "Actions"
+      [ KeyBinding "M-q" "close window" $ ftrAlways "kill window function" kill1
+      , KeyBinding "M-r" "run program" $ Left runCmdMenu
+      , KeyBinding "M-<Space>" "warp pointer" $ ftrAlways "warp function" $ warpToWindow 0.5 0.5
+      , KeyBinding "M-C-s" "capture area" $ Left $ runAreaCapture ses
+      , KeyBinding "M-C-S-s" "capture screen" $ Left $ runScreenCapture ses
+      , KeyBinding "M-C-d" "capture desktop" $ Left $ runDesktopCapture ses
+      , KeyBinding "M-C-b" "browse captures" $ Left runCaptureBrowser
+      -- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
+      ]
+  , KeyGroup
+      "Multimedia"
+      [ KeyBinding "<XF86AudioPlay>" "toggle play/pause" $ Left runTogglePlay
+      , KeyBinding "<XF86AudioPrev>" "previous track" $ Left runPrevTrack
+      , KeyBinding "<XF86AudioNext>" "next track" $ Left runNextTrack
+      , KeyBinding "<XF86AudioStop>" "stop" $ Left runStopPlay
+      , KeyBinding "<XF86AudioLowerVolume>" "volume down" $ Left runVolumeDown
+      , KeyBinding "<XF86AudioRaiseVolume>" "volume up" $ Left runVolumeUp
+      , KeyBinding "<XF86AudioMute>" "volume mute" $ Left runVolumeMute
+      ]
+  , KeyGroup
+      "Dunst"
+      [ KeyBinding "M-`" "dunst history" $ Left $ runNotificationHistory ses
+      , KeyBinding "M-S-`" "dunst close" $ Left $ runNotificationClose ses
+      , KeyBinding "M-M1-`" "dunst context menu" $ Left $ runNotificationContext ses
+      , KeyBinding "M-C-`" "dunst close all" $ Left $ runNotificationCloseAll ses
+      ]
+  , KeyGroup
+      "System"
+      [ KeyBinding "M-." "backlight up" $ ib bctlInc
+      , KeyBinding "M-," "backlight down" $ ib bctlDec
+      , KeyBinding "M-M1-," "backlight min" $ ib bctlMin
+      , KeyBinding "M-M1-." "backlight max" $ ib bctlMax
+      , KeyBinding "M-S-." "keyboard up" $ ck bctlInc
+      , KeyBinding "M-S-," "keyboard down" $ ck bctlDec
+      , KeyBinding "M-S-M1-," "keyboard min" $ ck bctlMin
+      , KeyBinding "M-S-M1-." "keyboard max" $ ck bctlMax
+      , KeyBinding "M-<End>" "power menu" $ Left runPowerPrompt
+      , KeyBinding "M-<Home>" "quit xmonad" $ Left runQuitPrompt
+      , KeyBinding "M-<Delete>" "lock screen" $ Left runScreenLock
+      , -- M-<F1> reserved for showing the keymap
+        KeyBinding "M-<F2>" "restart xmonad" restartf
+      , KeyBinding "M-<F3>" "recompile xmonad" recompilef
+      , KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
+      , KeyBinding "M-<F9>" "toggle ethernet" $ Left runToggleEthernet
+      , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ runToggleBluetooth sys
+      , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ callToggle ses
+      , KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt
+      ]
   ]
   where
     ses = dbSesClient db
diff --git a/fourmolu.yaml b/fourmolu.yaml
index 8a4d94e..190e1ca 100644
--- a/fourmolu.yaml
+++ b/fourmolu.yaml
@@ -1,7 +1,7 @@
 indentation: 2
-function-arrows: trailing
+function-arrows: leading
 comma-style: leading
-import-export-style: trailing
+import-export-style: leading
 indent-wheres: true
 record-brace-space: true
 newlines-between-decls: 1
diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 0bfe459..7015065 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -1,15 +1,15 @@
 --------------------------------------------------------------------------------
--- | Common internal DBus functions
+-- Common internal DBus functions
 
 module Data.Internal.DBus
-  ( SafeClient(..)
-  , SysClient(..)
-  , SesClient(..)
+  ( SafeClient (..)
+  , SysClient (..)
+  , SesClient (..)
   , addMatchCallback
   , matchProperty
   , matchPropertyFull
   , matchPropertyChanged
-  , SignalMatch(..)
+  , SignalMatch (..)
   , SignalCallback
   , MethodBody
   , withSignalMatch
@@ -25,22 +25,20 @@ module Data.Internal.DBus
   , addInterfaceRemovedListener
   , fromSingletonVariant
   , bodyToMaybe
-  ) where
+  )
+where
 
-import           Control.Exception
-import           Control.Monad
-
-import           Data.Bifunctor
-import qualified Data.Map.Strict   as M
-import           Data.Maybe
-
-import qualified RIO.Text          as T
-
-import           DBus
-import           DBus.Client
+import Control.Exception
+import Control.Monad
+import DBus
+import DBus.Client
+import Data.Bifunctor
+import qualified Data.Map.Strict as M
+import Data.Maybe
+import qualified RIO.Text as T
 
 --------------------------------------------------------------------------------
--- | Type-safe client
+-- Type-safe client
 
 class SafeClient c where
   toClient :: c -> Client
@@ -82,28 +80,37 @@ 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
+    Left e -> putStrLn (clientErrorMessage e) >> return Nothing
     Right c -> return $ Just c
 
 --------------------------------------------------------------------------------
--- | Methods
+-- Methods
 
 type MethodBody = Either T.Text [Variant]
 
 callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody
-callMethod' cl = fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
-  . call (toClient cl)
+callMethod' cl =
+  fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
+    . call (toClient cl)
 
-callMethod :: SafeClient c => c -> BusName -> ObjectPath -> InterfaceName
-  -> MemberName -> IO MethodBody
+callMethod
+  :: SafeClient c
+  => c
+  -> BusName
+  -> ObjectPath
+  -> InterfaceName
+  -> MemberName
+  -> IO MethodBody
 callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
 
 methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
-methodCallBus b p i m = (methodCall p i m)
-    { methodCallDestination = Just b }
+methodCallBus b p i m =
+  (methodCall p i m)
+    { methodCallDestination = Just b
+    }
 
 --------------------------------------------------------------------------------
--- | Bus names
+-- Bus names
 
 dbusInterface :: InterfaceName
 dbusInterface = interfaceName_ "org.freedesktop.DBus"
@@ -111,12 +118,14 @@ dbusInterface = interfaceName_ "org.freedesktop.DBus"
 callGetNameOwner :: SafeClient c => c -> BusName -> IO (Maybe BusName)
 callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
   where
-    mc = (methodCallBus dbusName dbusPath dbusInterface mem)
-      { methodCallBody = [toVariant name] }
+    mc =
+      (methodCallBus dbusName dbusPath dbusInterface mem)
+        { methodCallBody = [toVariant name]
+        }
     mem = memberName_ "GetNameOwner"
 
 --------------------------------------------------------------------------------
--- | Variant parsing
+-- Variant parsing
 
 fromSingletonVariant :: IsVariant a => [Variant] -> Maybe a
 fromSingletonVariant = fromVariant <=< listToMaybe
@@ -125,30 +134,45 @@ bodyToMaybe :: IsVariant a => MethodBody -> Maybe a
 bodyToMaybe = either (const Nothing) fromSingletonVariant
 
 --------------------------------------------------------------------------------
--- | Signals
+-- Signals
 
 type SignalCallback = [Variant] -> IO ()
 
-addMatchCallback :: SafeClient c => MatchRule -> SignalCallback -> c
+addMatchCallback
+  :: SafeClient c
+  => MatchRule
+  -> SignalCallback
+  -> c
   -> IO SignalHandler
 addMatchCallback rule cb cl = addMatch (toClient cl) rule $ cb . signalBody
 
-matchSignal :: Maybe BusName -> Maybe ObjectPath -> Maybe InterfaceName
-  -> Maybe MemberName -> MatchRule
-matchSignal b p i m = matchAny
-  { matchPath = p
-  , matchSender = b
-  , matchInterface = i
-  , matchMember = m
-  }
+matchSignal
+  :: Maybe BusName
+  -> Maybe ObjectPath
+  -> Maybe InterfaceName
+  -> Maybe MemberName
+  -> MatchRule
+matchSignal b p i m =
+  matchAny
+    { matchPath = p
+    , matchSender = b
+    , matchInterface = i
+    , matchMember = m
+    }
 
-matchSignalFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
-  -> Maybe InterfaceName -> Maybe MemberName -> IO (Maybe MatchRule)
+matchSignalFull
+  :: SafeClient c
+  => c
+  -> BusName
+  -> Maybe ObjectPath
+  -> Maybe InterfaceName
+  -> Maybe MemberName
+  -> IO (Maybe MatchRule)
 matchSignalFull client b p i m =
   fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
 
 --------------------------------------------------------------------------------
--- | Properties
+-- Properties
 
 propertyInterface :: InterfaceName
 propertyInterface = interfaceName_ "org.freedesktop.DBus.Properties"
@@ -156,16 +180,28 @@ propertyInterface = interfaceName_ "org.freedesktop.DBus.Properties"
 propertySignal :: MemberName
 propertySignal = memberName_ "PropertiesChanged"
 
-callPropertyGet :: SafeClient c => BusName -> ObjectPath -> InterfaceName
-  -> MemberName -> c -> IO [Variant]
-callPropertyGet bus path iface property cl = fmap (either (const []) (:[]))
-  $ getProperty (toClient cl) $ methodCallBus bus path iface property
+callPropertyGet
+  :: SafeClient c
+  => BusName
+  -> ObjectPath
+  -> InterfaceName
+  -> MemberName
+  -> c
+  -> IO [Variant]
+callPropertyGet bus path iface property cl =
+  fmap (either (const []) (: [])) $
+    getProperty (toClient cl) $
+      methodCallBus bus path iface property
 
 matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
 matchProperty b p =
   matchSignal b p (Just propertyInterface) (Just propertySignal)
 
-matchPropertyFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
+matchPropertyFull
+  :: SafeClient c
+  => c
+  -> BusName
+  -> Maybe ObjectPath
   -> IO (Maybe MatchRule)
 matchPropertyFull cl b p =
   matchSignalFull cl b p (Just propertyInterface) (Just propertySignal)
@@ -174,25 +210,30 @@ data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show)
 
 withSignalMatch :: (Maybe a -> IO ()) -> SignalMatch a -> IO ()
 withSignalMatch f (Match x) = f (Just x)
-withSignalMatch f Failure   = f Nothing
-withSignalMatch _ NoMatch   = return ()
+withSignalMatch f Failure = f Nothing
+withSignalMatch _ NoMatch = return ()
 
-matchPropertyChanged :: IsVariant a => InterfaceName -> T.Text -> [Variant]
+matchPropertyChanged
+  :: IsVariant a
+  => InterfaceName
+  -> T.Text
+  -> [Variant]
   -> SignalMatch a
 matchPropertyChanged iface property [i, body, _] =
   let i' = (fromVariant i :: Maybe T.Text)
-      b = toMap body in
-    case (i', b) of
-      (Just i'', Just b') -> if i'' == T.pack (formatInterfaceName iface) then
-        maybe NoMatch Match $ fromVariant =<< M.lookup property b'
-        else NoMatch
-      _                   -> Failure
+      b = toMap body
+   in case (i', b) of
+        (Just i'', Just b') ->
+          if i'' == T.pack (formatInterfaceName iface)
+            then maybe NoMatch Match $ fromVariant =<< M.lookup property b'
+            else NoMatch
+        _ -> Failure
   where
     toMap v = fromVariant v :: Maybe (M.Map T.Text Variant)
 matchPropertyChanged _ _ _ = Failure
 
 --------------------------------------------------------------------------------
--- | Object Manager
+-- Object Manager
 
 type ObjectTree = M.Map ObjectPath (M.Map T.Text (M.Map T.Text Variant))
 
@@ -208,24 +249,44 @@ omInterfacesAdded = memberName_ "InterfacesAdded"
 omInterfacesRemoved :: MemberName
 omInterfacesRemoved = memberName_ "InterfacesRemoved"
 
-callGetManagedObjects :: SafeClient c => c -> BusName -> ObjectPath
+callGetManagedObjects
+  :: SafeClient c
+  => c
+  -> BusName
+  -> ObjectPath
   -> IO ObjectTree
 callGetManagedObjects cl bus path =
   either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
-  <$> callMethod cl bus path omInterface getManagedObjects
+    <$> callMethod cl bus path omInterface getManagedObjects
 
-addInterfaceChangedListener :: SafeClient c => BusName -> MemberName
-  -> ObjectPath -> SignalCallback -> c -> IO (Maybe SignalHandler)
+addInterfaceChangedListener
+  :: SafeClient c
+  => BusName
+  -> MemberName
+  -> ObjectPath
+  -> SignalCallback
+  -> c
+  -> IO (Maybe SignalHandler)
 addInterfaceChangedListener bus prop path sc cl = do
   rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
   forM rule $ \r -> addMatchCallback r sc cl
 
-addInterfaceAddedListener :: SafeClient c => BusName -> ObjectPath
-  -> SignalCallback -> c -> IO (Maybe SignalHandler)
+addInterfaceAddedListener
+  :: SafeClient c
+  => BusName
+  -> ObjectPath
+  -> SignalCallback
+  -> c
+  -> IO (Maybe SignalHandler)
 addInterfaceAddedListener bus =
   addInterfaceChangedListener bus omInterfacesAdded
 
-addInterfaceRemovedListener :: SafeClient c => BusName -> ObjectPath
-  -> SignalCallback -> c -> IO (Maybe SignalHandler)
+addInterfaceRemovedListener
+  :: SafeClient c
+  => BusName
+  -> ObjectPath
+  -> SignalCallback
+  -> c
+  -> IO (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
   addInterfaceChangedListener bus omInterfacesRemoved
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index 930ce34..8ba3d44 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -1,61 +1,57 @@
-{-# LANGUAGE DeriveFunctor       #-}
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 --------------------------------------------------------------------------------
--- | Functions for handling dependencies
+-- Functions for handling dependencies
 
 module Data.Internal.Dependency
-  -- feature types
+-- feature types
   ( Feature
-  , Always(..)
-  , Always_(..)
-  , FallbackRoot(..)
-  , FallbackStack(..)
-  , Sometimes(..)
+  , Always (..)
+  , Always_ (..)
+  , FallbackRoot (..)
+  , FallbackStack (..)
+  , Sometimes (..)
   , Sometimes_
   , AlwaysX
   , AlwaysIO
   , SometimesX
   , SometimesIO
-  , PostPass(..)
-  , Subfeature(..)
+  , PostPass (..)
+  , Subfeature (..)
   , SubfeatureRoot
-  , Msg(..)
-
+  , Msg (..)
   -- configuration
-  , XParams(..)
-  , XPFeatures(..)
+  , XParams (..)
+  , XPFeatures (..)
   , XPQuery
-
   -- dependency tree types
-  , Root(..)
-  , Tree(..)
-  , Tree_(..)
+  , Root (..)
+  , Tree (..)
+  , Tree_ (..)
   , IOTree
   , IOTree_
   , DBusTree
   , DBusTree_
-  , SafeClient(..)
-  , IODependency(..)
-  , IODependency_(..)
-  , SystemDependency(..)
-  , DBusDependency_(..)
-  , DBusMember(..)
-  , UnitType(..)
+  , SafeClient (..)
+  , IODependency (..)
+  , IODependency_ (..)
+  , SystemDependency (..)
+  , DBusDependency_ (..)
+  , DBusMember (..)
+  , UnitType (..)
   , Result
-  , Fulfillment(..)
-  , ArchPkg(..)
-
+  , Fulfillment (..)
+  , ArchPkg (..)
   -- dumping
   , dumpFeature
   , dumpAlways
   , dumpSometimes
   , showFulfillment
-
   -- testing
   , FIO
   , withCache
@@ -72,11 +68,9 @@ module Data.Internal.Dependency
   , readEthernet
   , readWireless
   , socketExists
-
   -- lifting
   , ioSometimes
   , ioAlways
-
   -- feature construction
   , always1
   , sometimes1
@@ -86,7 +80,6 @@ module Data.Internal.Dependency
   , sometimesExe
   , sometimesExeArgs
   , sometimesEndpoint
-
   -- dependency construction
   , sysExe
   , localExe
@@ -101,47 +94,41 @@ module Data.Internal.Dependency
   , voidResult
   , voidRead
   , process
-
   -- misc
   , shellTest
-  ) where
+  )
+where
 
-import           Control.Monad.IO.Class
-import           Control.Monad.Identity
-import           Control.Monad.Reader
-
-import           Data.Aeson             hiding (Error, Result)
-import           Data.Aeson.Key
-import           Data.Bifunctor
-import           Data.Either
-import           Data.Internal.DBus
-import           Data.List
-import           Data.Maybe
-import           Data.Yaml
-
-import           GHC.IO.Exception       (ioe_description)
-
-import           DBus                   hiding (typeOf)
-import qualified DBus.Introspection     as I
-
-import           RIO                    hiding (bracket, fromString)
-import           RIO.FilePath
-import           RIO.Process            hiding (findExecutable)
-import qualified RIO.Text               as T
-
-import           System.Directory
-import           System.Environment
-import           System.IO.Error
-import           System.Posix.Files
-import           System.Process.Typed   (nullStream)
-
-import           XMonad.Core            (X, io)
-import           XMonad.Internal.IO
-import           XMonad.Internal.Shell  hiding (proc, runProcess)
-import           XMonad.Internal.Theme
+import Control.Monad.IO.Class
+import Control.Monad.Identity
+import Control.Monad.Reader
+import DBus hiding (typeOf)
+import qualified DBus.Introspection as I
+import Data.Aeson hiding (Error, Result)
+import Data.Aeson.Key
+import Data.Bifunctor
+import Data.Either
+import Data.Internal.DBus
+import Data.List
+import Data.Maybe
+import Data.Yaml
+import GHC.IO.Exception (ioe_description)
+import RIO hiding (bracket, fromString)
+import RIO.FilePath
+import RIO.Process hiding (findExecutable)
+import qualified RIO.Text as T
+import System.Directory
+import System.Environment
+import System.IO.Error
+import System.Posix.Files
+import System.Process.Typed (nullStream)
+import XMonad.Core (X, io)
+import XMonad.Internal.IO
+import XMonad.Internal.Shell hiding (proc, runProcess)
+import XMonad.Internal.Theme
 
 --------------------------------------------------------------------------------
--- | Feature Evaluation
+-- Feature Evaluation
 --
 -- Here we attempt to build and return the monadic actions encoded by each
 -- feature.
@@ -168,7 +155,7 @@ executeSometimes a = maybe (return Nothing) (fmap Just) =<< evalSometimes a
 -- | Possibly return the action of an Always/Sometimes
 evalFeature :: Feature a -> FIO (Maybe a)
 evalFeature (Right a) = Just <$> evalAlways a
-evalFeature (Left s)  = evalSometimes s
+evalFeature (Left s) = evalSometimes s
 
 -- | Possibly return the action of a Sometimes
 evalSometimes :: Sometimes a -> FIO (Maybe a)
@@ -191,19 +178,20 @@ logMsg (FMsg fn n (Msg ll m)) = do
   f $ Utf8Builder $ encodeUtf8Builder $ T.unwords $ fmt s (T.pack p)
   where
     llFun LevelError = ("ERROR", logError)
-    llFun LevelInfo  = ("INFO", logInfo)
-    llFun LevelWarn  = ("WARN", logWarn)
-    llFun _          = ("DEBUG", logDebug)
+    llFun LevelInfo = ("INFO", logInfo)
+    llFun LevelWarn = ("WARN", logWarn)
+    llFun _ = ("DEBUG", logDebug)
     (s, f) = llFun ll
-    fmt p l = [ bracket p
-              , bracket l
-              , bracket fn
-              ]
-              ++ maybe [] ((:[]) . bracket) n
-              ++ [m]
+    fmt p l =
+      [ bracket p
+      , bracket l
+      , bracket fn
+      ]
+        ++ maybe [] ((: []) . bracket) n
+        ++ [m]
 
 --------------------------------------------------------------------------------
--- | Package status
+-- Package status
 
 showFulfillment :: Fulfillment -> T.Text
 showFulfillment (Package t n) = T.concat [T.pack $ show t, "\t", n]
@@ -214,13 +202,13 @@ dumpFeature = either dumpSometimes dumpAlways
 dumpAlways :: Always a -> [Fulfillment]
 dumpAlways (Always _ x) = case x of
   (Option o _) -> nub $ dataSubfeatureRoot o
-  _            -> []
+  _ -> []
 
 dumpSometimes :: Sometimes a -> [Fulfillment]
 dumpSometimes (Sometimes _ _ xs) = nub $ concatMap dataSubfeatureRoot xs
 
 --------------------------------------------------------------------------------
--- | Wrapper types
+-- Wrapper types
 
 type AlwaysX = Always (X ())
 
@@ -233,7 +221,7 @@ type SometimesIO = Sometimes (FIO ())
 type Feature a = Either (Sometimes a) (Always a)
 
 --------------------------------------------------------------------------------
--- | Feature declaration
+-- Feature declaration
 
 -- | Feature that is guaranteed to work
 -- This is composed of sub-features that are tested in order, and if all fail
@@ -241,17 +229,20 @@ type Feature a = Either (Sometimes a) (Always a)
 data Always a = Always T.Text (Always_ a)
 
 -- | Feature that is guaranteed to work (inner data)
-data Always_ a = Option (SubfeatureRoot a) (Always_ a)
+data Always_ a
+  = Option (SubfeatureRoot a) (Always_ a)
   | Always_ (FallbackRoot a)
 
 -- | Root of a fallback action for an always
 -- This may either be a lone action or a function that depends on the results
 -- from other Always features.
-data FallbackRoot a = FallbackAlone a
+data FallbackRoot a
+  = FallbackAlone a
   | forall p. FallbackTree (p -> a) (FallbackStack p)
 
 -- | Always features that are used as a payload for a fallback action
-data FallbackStack p = FallbackBottom (Always p)
+data FallbackStack p
+  = FallbackBottom (Always p)
   | forall x y. FallbackStack (x -> y -> p) (Always x) (FallbackStack y)
 
 -- | Feature that might not be present
@@ -276,14 +267,15 @@ type SubfeatureRoot a = Subfeature (Root a)
 -- | An action and its dependencies
 -- May be a plain old monad or be DBus-dependent, in which case a client is
 -- needed
-data Root a = forall p. IORoot (p -> a) (IOTree p)
+data Root a
+  = forall p. IORoot (p -> a) (IOTree p)
   | IORoot_ a IOTree_
   | forall c p. SafeClient c => DBusRoot (p -> c -> a) (DBusTree c p) (Maybe c)
   | forall c. SafeClient c => DBusRoot_ (c -> a) (DBusTree_ c) (Maybe c)
 
 -- | The dependency tree with rule to merge results when needed
-data Tree d d_ p =
-  forall x y. And12 (x -> y -> p) (Tree d d_ x) (Tree d d_ y)
+data Tree d d_ p
+  = forall x y. And12 (x -> y -> p) (Tree d d_ x) (Tree d d_ y)
   | And1 (Tree d d_ p) (Tree_ d_)
   | And2 (Tree_ d_) (Tree d d_ p)
   | Or (Tree d d_ p) (Tree d d_ p)
@@ -294,36 +286,41 @@ data Tree_ d = And_ (Tree_ d) (Tree_ d) | Or_ (Tree_ d) (Tree_ d) | Only_ d
 
 -- | Shorthand tree types for lazy typers
 type IOTree p = Tree IODependency IODependency_ p
+
 type DBusTree c p = Tree IODependency (DBusDependency_ c) p
+
 type IOTree_ = Tree_ IODependency_
+
 type DBusTree_ c = Tree_ (DBusDependency_ c)
 
 -- | A dependency that only requires IO to evaluate (with payload)
-data IODependency p =
-  -- an IO action that yields a payload
-  IORead T.Text [Fulfillment] (FIO (Result p))
-  -- always yields a payload
-  | IOConst p
-  -- an always that yields a payload
-  | forall a. IOAlways (Always a) (a -> p)
-  -- a sometimes that yields a payload
-  | forall a. IOSometimes (Sometimes a) (a -> p)
+data IODependency p
+  = -- an IO action that yields a payload
+    IORead T.Text [Fulfillment] (FIO (Result p))
+  | -- always yields a payload
+    IOConst p
+  | -- an always that yields a payload
+    forall a. IOAlways (Always a) (a -> p)
+  | -- a sometimes that yields a payload
+    forall a. IOSometimes (Sometimes a) (a -> p)
 
 -- | A dependency pertaining to the DBus
-data DBusDependency_ c = Bus [Fulfillment] BusName
+data DBusDependency_ c
+  = Bus [Fulfillment] BusName
   | Endpoint [Fulfillment] BusName ObjectPath InterfaceName DBusMember
   | DBusIO IODependency_
   deriving (Generic)
 
 -- | A dependency that only requires IO to evaluate (no payload)
-data IODependency_ = IOSystem_ [Fulfillment] SystemDependency
+data IODependency_
+  = IOSystem_ [Fulfillment] SystemDependency
   | IOTest_ T.Text [Fulfillment] (FIO (Maybe Msg))
   | forall a. IOSometimes_ (Sometimes a)
 
 -- | A system component to an IODependency
 -- This name is dumb, but most constructors should be obvious
-data SystemDependency =
-  Executable Bool FilePath
+data SystemDependency
+  = Executable Bool FilePath
   | AccessiblePath FilePath Bool Bool
   | Systemd UnitType T.Text
   | Process T.Text
@@ -333,7 +330,8 @@ data SystemDependency =
 data UnitType = SystemUnit | UserUnit deriving (Eq, Show, Generic)
 
 -- | Wrapper type to describe and endpoint
-data DBusMember = Method_ MemberName
+data DBusMember
+  = Method_ MemberName
   | Signal_ MemberName
   | Property_ T.Text
   deriving (Eq, Show, Generic)
@@ -345,7 +343,7 @@ data Fulfillment = Package ArchPkg T.Text deriving (Eq, Show, Ord)
 data ArchPkg = Official | AUR | Custom deriving (Eq, Show, Generic, Ord)
 
 --------------------------------------------------------------------------------
--- | Tested dependency tree
+-- Tested dependency tree
 --
 -- The main reason I need this is so I have a "result" I can convert to JSON
 -- and dump on the CLI (unless there is a way to make Aeson work inside an IO)
@@ -357,13 +355,14 @@ data Msg = Msg LogLevel T.Text
 data FMsg = FMsg T.Text (Maybe T.Text) Msg
 
 -- | Tested Always feature
-data PostAlways a = Primary (SubfeaturePass a) [SubfeatureFail] (Always_ a)
+data PostAlways a
+  = Primary (SubfeaturePass a) [SubfeatureFail] (Always_ a)
   | Fallback a [SubfeatureFail]
 
 -- | Tested Sometimes feature
 data PostSometimes a = PostSometimes
   { psSuccess :: Maybe (SubfeaturePass a)
-  , psFailed  :: [SubfeatureFail]
+  , psFailed :: [SubfeatureFail]
   }
 
 -- | Passing subfeature
@@ -382,21 +381,21 @@ addMsgs (PostPass a ms) ms' = PostPass a $ ms ++ ms'
 data PostFail = PostFail [Msg] | PostMissing Msg
 
 --------------------------------------------------------------------------------
--- | Configuration
+-- Configuration
 
 type FIO a = RIO DepStage a
 
 data DepStage = DepStage
-  { dsLogFun  :: !LogFunc
+  { dsLogFun :: !LogFunc
   , dsProcCxt :: !ProcessContext
-  , dsParams  :: !XParams
+  , dsParams :: !XParams
   }
 
 instance HasLogFunc DepStage where
-  logFuncL = lens dsLogFun (\x y -> x { dsLogFun = y })
+  logFuncL = lens dsLogFun (\x y -> x {dsLogFun = y})
 
 instance HasProcessContext DepStage where
-  processContextL = lens dsProcCxt (\x y -> x { dsProcCxt = y })
+  processContextL = lens dsProcCxt (\x y -> x {dsProcCxt = y})
 
 data XParams = XParams
   { xpLogLevel :: LogLevel
@@ -413,61 +412,75 @@ instance FromJSON XParams where
     ll <- mapLevel <$> o .: fromString "loglevel"
     fs <- o .: fromString "features"
     return $ XParams ll fs
-      where
-        mapLevel Info  = LevelInfo
-        mapLevel Error = LevelError
-        mapLevel Warn  = LevelWarn
-        mapLevel Debug = LevelDebug
+    where
+      mapLevel Info = LevelInfo
+      mapLevel Error = LevelError
+      mapLevel Warn = LevelWarn
+      mapLevel Debug = LevelDebug
 
 data XPFeatures = XPFeatures
-  { xpfOptimus        :: Bool
-  , xpfVirtualBox     :: Bool
-  , xpfXSANE          :: Bool
-  , xpfEthernet       :: Bool
-  , xpfWireless       :: Bool
-  , xpfVPN            :: Bool
-  , xpfBluetooth      :: Bool
+  { xpfOptimus :: Bool
+  , xpfVirtualBox :: Bool
+  , xpfXSANE :: Bool
+  , xpfEthernet :: Bool
+  , xpfWireless :: Bool
+  , xpfVPN :: Bool
+  , xpfBluetooth :: Bool
   , xpfIntelBacklight :: Bool
   , xpfClevoBacklight :: Bool
-  , xpfBattery        :: Bool
-  , xpfF5VPN          :: Bool
+  , xpfBattery :: Bool
+  , xpfF5VPN :: Bool
   }
 
 instance FromJSON XPFeatures where
-  parseJSON = withObject "features" $ \o -> XPFeatures
-    <$> o .:+ "optimus"
-    <*> o .:+ "virtualbox"
-    <*> o .:+ "xsane"
-    <*> o .:+ "ethernet"
-    <*> o .:+ "wireless"
-    <*> o .:+ "vpn"
-    <*> o .:+ "bluetooth"
-    <*> o .:+ "intel_backlight"
-    <*> o .:+ "clevo_backlight"
-    <*> o .:+ "battery"
-    <*> o .:+ "f5vpn"
+  parseJSON = withObject "features" $ \o ->
+    XPFeatures
+      <$> o
+      .:+ "optimus"
+      <*> o
+      .:+ "virtualbox"
+      <*> o
+      .:+ "xsane"
+      <*> o
+      .:+ "ethernet"
+      <*> o
+      .:+ "wireless"
+      <*> o
+      .:+ "vpn"
+      <*> o
+      .:+ "bluetooth"
+      <*> o
+      .:+ "intel_backlight"
+      <*> o
+      .:+ "clevo_backlight"
+      <*> o
+      .:+ "battery"
+      <*> o
+      .:+ "f5vpn"
 
 defParams :: XParams
-defParams = XParams
-  { xpLogLevel = LevelError
-  , xpFeatures = defXPFeatures
-  }
+defParams =
+  XParams
+    { xpLogLevel = LevelError
+    , xpFeatures = defXPFeatures
+    }
 
 defXPFeatures :: XPFeatures
-defXPFeatures = XPFeatures
-  { xpfOptimus = False
-  , xpfVirtualBox = False
-  , xpfXSANE = False
-  , xpfEthernet = False
-  , xpfWireless = False
-  -- TODO this might be broken down into different flags (expressvpn, etc)
-  , xpfVPN = False
-  , xpfBluetooth = False
-  , xpfIntelBacklight = False
-  , xpfClevoBacklight = False
-  , xpfBattery = False
-  , xpfF5VPN = False
-  }
+defXPFeatures =
+  XPFeatures
+    { xpfOptimus = False
+    , xpfVirtualBox = False
+    , xpfXSANE = False
+    , xpfEthernet = False
+    , xpfWireless = False
+    , -- TODO this might be broken down into different flags (expressvpn, etc)
+      xpfVPN = False
+    , xpfBluetooth = False
+    , xpfIntelBacklight = False
+    , xpfClevoBacklight = False
+    , xpfBattery = False
+    , xpfF5VPN = False
+    }
 
 type XPQuery = XPFeatures -> Bool
 
@@ -476,8 +489,9 @@ getParams = do
   p <- getParamFile
   maybe (return defParams) decodeYaml p
   where
-    decodeYaml p = either (\e -> print e >> return defParams) return
-      =<< decodeFileEither p
+    decodeYaml p =
+      either (\e -> print e >> return defParams) return
+        =<< decodeFileEither p
 
 getParamFile :: IO (Maybe FilePath)
 getParamFile = do
@@ -495,20 +509,22 @@ getParamFile = do
 (.:+) :: Object -> String -> Parser Bool
 (.:+) o n = o .:? fromString n .!= False
 
-infix .:+
+infix 9 .:+
 
 --------------------------------------------------------------------------------
--- | Testing pipeline
+-- Testing pipeline
 
 evalSometimesMsg :: Sometimes a -> FIO (Either [FMsg] (a, [FMsg]))
 evalSometimesMsg (Sometimes n u xs) = do
   r <- asks (u . xpFeatures . dsParams)
-  if not r then return $ Left [dis n] else do
-    PostSometimes { psSuccess = s, psFailed = fs } <- testSometimes xs
-    let fs' = failedMsgs n fs
-    return $ case s of
-      (Just p) -> Right $ second (++ fs') $ passActMsg n p
-      _        -> Left fs'
+  if not r
+    then return $ Left [dis n]
+    else do
+      PostSometimes {psSuccess = s, psFailed = fs} <- testSometimes xs
+      let fs' = failedMsgs n fs
+      return $ case s of
+        (Just p) -> Right $ second (++ fs') $ passActMsg n p
+        _ -> Left fs'
   where
     dis name = FMsg name Nothing (Msg LevelDebug "feature disabled")
 
@@ -516,18 +532,18 @@ evalAlwaysMsg :: Always a -> FIO (a, [FMsg])
 evalAlwaysMsg (Always n x) = do
   r <- testAlways x
   return $ case r of
-    (Primary p fs _)  -> second (++ failedMsgs n fs) $ passActMsg n p
+    (Primary p fs _) -> second (++ failedMsgs n fs) $ passActMsg n p
     (Fallback act fs) -> (act, failedMsgs n fs)
 
 passActMsg :: T.Text -> SubfeaturePass a -> (a, [FMsg])
-passActMsg fn Subfeature { sfData = PostPass a ws, sfName = n } = (a, fmap (FMsg fn (Just n)) ws)
+passActMsg fn Subfeature {sfData = PostPass a ws, sfName = n} = (a, fmap (FMsg fn (Just n)) ws)
 
 failedMsgs :: T.Text -> [SubfeatureFail] -> [FMsg]
 failedMsgs n = concatMap (failedMsg n)
 
 failedMsg :: T.Text -> SubfeatureFail -> [FMsg]
-failedMsg fn Subfeature { sfData = d, sfName = n } = case d of
-  (PostFail es)   -> f es
+failedMsg fn Subfeature {sfData = d, sfName = n} = case d of
+  (PostFail es) -> f es
   (PostMissing e) -> f [e]
   where
     f = fmap (FMsg fn (Just n))
@@ -538,12 +554,12 @@ testAlways = go []
     go failed (Option fd next) = do
       r <- testSubfeature fd
       case r of
-        (Left l)     -> go (l:failed) next
+        (Left l) -> go (l : failed) next
         (Right pass) -> return $ Primary pass failed next
     go failed (Always_ ar) = (`Fallback` failed) <$> evalFallbackRoot ar
 
 evalFallbackRoot :: FallbackRoot a -> FIO a
-evalFallbackRoot (FallbackAlone a)  = return a
+evalFallbackRoot (FallbackAlone a) = return a
 evalFallbackRoot (FallbackTree a s) = a <$> evalFallbackStack s
 
 evalFallbackStack :: FallbackStack p -> FIO p
@@ -557,27 +573,30 @@ testSometimes :: Sometimes_ a -> FIO (PostSometimes a)
 testSometimes = go (PostSometimes Nothing [])
   where
     go ts [] = return ts
-    go ts (x:xs) = do
+    go ts (x : xs) = do
       sf <- testSubfeature x
       case sf of
-        (Left l)     -> go (ts { psFailed = l:psFailed ts }) xs
-        (Right pass) -> return $ ts { psSuccess = Just pass }
+        (Left l) -> go (ts {psFailed = l : psFailed ts}) xs
+        (Right pass) -> return $ ts {psSuccess = Just pass}
 
 testSubfeature :: SubfeatureRoot a -> FIO (Either SubfeatureFail (SubfeaturePass a))
-testSubfeature sf@Subfeature{ sfData = t } = do
+testSubfeature sf@Subfeature {sfData = t} = do
   t' <- testRoot t
   -- monomorphism restriction :(
-  return $ bimap (\n -> sf { sfData = n }) (\n -> sf { sfData = n }) t'
+  return $ bimap (\n -> sf {sfData = n}) (\n -> sf {sfData = n}) t'
 
 testRoot :: Root a -> FIO (Either PostFail (PostPass a))
 testRoot r = do
   case r of
-    (IORoot a t)              -> go a testIODep_ testIODep t
-    (IORoot_ a t)             -> go_ a testIODep_ t
-    (DBusRoot a t (Just cl))  -> go (`a` cl) (testDBusDep_ cl) testIODep t
+    (IORoot a t) -> go a testIODep_ testIODep t
+    (IORoot_ a t) -> go_ a testIODep_ t
+    (DBusRoot a t (Just cl)) -> go (`a` cl) (testDBusDep_ cl) testIODep t
     (DBusRoot_ a t (Just cl)) -> go_ (a cl) (testDBusDep_ cl) t
-    _                         -> return $ Left $ PostMissing
-                                 $ Msg LevelError "client not available"
+    _ ->
+      return $
+        Left $
+          PostMissing $
+            Msg LevelError "client not available"
   where
     -- rank N polymorphism is apparently undecidable...gross
     go a f_ (f :: forall q. d q -> FIO (MResult q)) t =
@@ -585,13 +604,15 @@ testRoot r = do
     go_ a f_ t = bimap PostFail (PostPass a) <$> testTree_ f_ t
 
 --------------------------------------------------------------------------------
--- | Payloaded dependency testing
+-- Payloaded dependency testing
 
 type Result p = Either [Msg] (PostPass p)
 
 type MResult p = Memoized (Result p)
 
-testTree :: forall d d_ p. (d_ -> FIO MResult_)
+testTree
+  :: forall d d_ p
+   . (d_ -> FIO MResult_)
   -> (forall q. d q -> FIO (MResult q))
   -> Tree d d_ p
   -> FIO (Either [Msg] (PostPass p))
@@ -610,30 +631,34 @@ testTree test_ test = go
     go (Or a b) = do
       ra <- go a
       either (\ea -> fmap (`addMsgs` ea) <$> go b) (return . Right) ra
-    go (Only a)    = runMemoized =<< test a
+    go (Only a) = runMemoized =<< test a
     and2nd f (PostPass pa wa) (PostPass pb wb) = Right $ PostPass (f pa pb) $ wa ++ wb
     liftRight = either (return . Left)
 
 testIODep :: IODependency p -> FIO (MResult p)
 testIODep d = memoizeMVar $ case d of
   IORead _ _ t -> t
-  IOConst c    -> return $ Right $ PostPass c []
+  IOConst c -> return $ Right $ PostPass c []
   -- TODO this is a bit odd because this is a dependency that will always
   -- succeed, which kinda makes this pointless. The only reason I would want
   -- this is if I want to have a built-in logic to "choose" a payload to use in
   -- building a higher-level feature
-  IOAlways a f     -> Right . uncurry PostPass
-  -- TODO this is wetter than Taco Bell shit
-    . bimap f (fmap stripMsg) <$> evalAlwaysMsg a
-  IOSometimes x f  -> bimap (fmap stripMsg) (uncurry PostPass . bimap f (fmap stripMsg))
-    <$> evalSometimesMsg x
+  IOAlways a f ->
+    Right
+      . uncurry PostPass
+      -- TODO this is wetter than Taco Bell shit
+      . bimap f (fmap stripMsg)
+      <$> evalAlwaysMsg a
+  IOSometimes x f ->
+    bimap (fmap stripMsg) (uncurry PostPass . bimap f (fmap stripMsg))
+      <$> evalSometimesMsg x
 
 stripMsg :: FMsg -> Msg
 stripMsg (FMsg _ _ m) = m
 
 --------------------------------------------------------------------------------
--- | Standalone dependency testing
 
+-- | Standalone dependency testing
 type Result_ = Either [Msg] [Msg]
 
 type MResult_ = Memoized Result_
@@ -642,8 +667,8 @@ testTree_ :: (d -> FIO MResult_) -> Tree_ d -> FIO Result_
 testTree_ test = go
   where
     go (And_ a b) = either (return . Left) (`test2nd` b) =<< go a
-    go (Or_ a b)  = either (`test2nd` b) (return . Right) =<< go a
-    go (Only_ a)  = runMemoized =<< test a
+    go (Or_ a b) = either (`test2nd` b) (return . Right) =<< go a
+    go (Only_ a) = runMemoized =<< test a
     test2nd ws = fmap ((Right . (ws ++)) =<<) . go
 
 testIODep_ :: IODependency_ -> FIO MResult_
@@ -652,15 +677,18 @@ testIODep_ d = memoizeMVar $ testIODepNoCache_ d
 testIODepNoCache_ :: IODependency_ -> FIO Result_
 testIODepNoCache_ (IOSystem_ _ s) = readResult_ <$> testSysDependency s
 testIODepNoCache_ (IOTest_ _ _ t) = readResult_ <$> t
-testIODepNoCache_ (IOSometimes_ x) = bimap (fmap stripMsg) (fmap stripMsg . snd)
-  <$> evalSometimesMsg x
+testIODepNoCache_ (IOSometimes_ x) =
+  bimap (fmap stripMsg) (fmap stripMsg . snd)
+    <$> evalSometimesMsg x
 
 --------------------------------------------------------------------------------
--- | System Dependency Testing
 
+-- | System Dependency Testing
 testSysDependency :: SystemDependency -> FIO (Maybe Msg)
-testSysDependency (Executable sys bin) = io $ maybe (Just msg) (const Nothing)
-  <$> findExecutable bin
+testSysDependency (Executable sys bin) =
+  io $
+    maybe (Just msg) (const Nothing)
+      <$> findExecutable bin
   where
     msg = Msg LevelError $ T.unwords [e, "executable", singleQuote $ T.pack bin, "not found"]
     e = if sys then "system" else "local"
@@ -668,35 +696,36 @@ testSysDependency (Systemd t n) = shellTest "systemctl" args msg
   where
     msg = T.unwords ["systemd", unitType t, "unit", singleQuote n, "not found"]
     args = ["--user" | t == UserUnit] ++ ["status", n]
-testSysDependency (Process n) = shellTest "pidof" [n]
-  $ T.unwords ["Process", singleQuote n, "not found"]
+testSysDependency (Process n) =
+  shellTest "pidof" [n] $
+    T.unwords ["Process", singleQuote n, "not found"]
 testSysDependency (AccessiblePath p r w) = io $ permMsg <$> getPermissionsSafe p
   where
-    testPerm False _ _  = Nothing
+    testPerm False _ _ = Nothing
     testPerm True f res = Just $ f res
     mkErr = Just . Msg LevelError
-    permMsg NotFoundError            = mkErr "file not found"
-    permMsg PermError                = mkErr "could not get permissions"
+    permMsg NotFoundError = mkErr "file not found"
+    permMsg PermError = mkErr "could not get permissions"
     permMsg (PermResult res) =
       case (testPerm r readable res, testPerm w writable res) of
         (Just False, Just False) -> mkErr "file not readable or writable"
-        (Just False, _)          -> mkErr "file not readable"
-        (_, Just False)          -> mkErr "file not writable"
-        _                        -> Nothing
+        (Just False, _) -> mkErr "file not readable"
+        (_, Just False) -> mkErr "file not writable"
+        _ -> Nothing
 
 shellTest :: FilePath -> [T.Text] -> T.Text -> FIO (Maybe Msg)
 shellTest cmd args msg = do
   rc <- proc cmd (T.unpack <$> args) (runProcess . setStdout nullStream)
   return $ case rc of
     ExitSuccess -> Nothing
-    _           -> Just $ Msg LevelError msg
+    _ -> Just $ Msg LevelError msg
 
 unitType :: UnitType -> T.Text
 unitType SystemUnit = "system"
-unitType UserUnit   = "user"
+unitType UserUnit = "user"
 
 --------------------------------------------------------------------------------
--- | Font testers
+-- Font testers
 --
 -- Make a special case for these since we end up testing the font alot, and it
 -- would be nice if I can cache them.
@@ -706,7 +735,7 @@ fontAlways n fam ful = always1 n (fontFeatureName fam) root fallbackFont
   where
     root = IORoot id $ fontTree fam ful
 
-fontSometimes :: T.Text -> T.Text -> [Fulfillment]-> Sometimes FontBuilder
+fontSometimes :: T.Text -> T.Text -> [Fulfillment] -> Sometimes FontBuilder
 fontSometimes n fam ful = sometimes1 n (fontFeatureName fam) root
   where
     root = IORoot id $ fontTree fam ful
@@ -736,7 +765,7 @@ fontTestName fam = T.unwords ["test if font", singleQuote fam, "exists"]
 -- testFont = liftIO . testFont'
 
 testFont :: T.Text -> FIO (Result FontBuilder)
-testFont fam = maybe pass (Left . (:[])) <$> shellTest "fc-list" args msg
+testFont fam = maybe pass (Left . (: [])) <$> shellTest "fc-list" args msg
   where
     msg = T.unwords ["font family", qFam, "not found"]
     args = [qFam]
@@ -744,7 +773,7 @@ testFont fam = maybe pass (Left . (:[])) <$> shellTest "fc-list" args msg
     pass = Right $ PostPass (buildFont $ Just fam) []
 
 --------------------------------------------------------------------------------
--- | Network Testers
+-- Network Testers
 --
 -- ASSUME that the system uses systemd in which case ethernet interfaces always
 -- start with "en" and wireless interfaces always start with "wl"
@@ -762,8 +791,9 @@ isEthernet :: T.Text -> Bool
 isEthernet = T.isPrefixOf "en"
 
 listInterfaces :: IO [T.Text]
-listInterfaces = fromRight []
-  <$> tryIOError (fmap T.pack <$> listDirectory sysfsNet)
+listInterfaces =
+  fromRight []
+    <$> tryIOError (fmap T.pack <$> listDirectory sysfsNet)
 
 sysfsNet :: FilePath
 sysfsNet = "/sys/class/net"
@@ -777,29 +807,33 @@ readInterface n f = IORead n [] go
       ns <- filter f <$> listInterfaces
       case ns of
         [] -> return $ Left [Msg LevelError "no interfaces found"]
-        (x:xs) -> do
-          return $ Right $ PostPass x
-            $ fmap (Msg LevelWarn . T.append "ignoring extra interface: ") xs
+        (x : xs) -> do
+          return $
+            Right $
+              PostPass x $
+                fmap (Msg LevelWarn . T.append "ignoring extra interface: ") xs
 
 --------------------------------------------------------------------------------
--- | Misc testers
+-- Misc testers
 
 socketExists :: T.Text -> [Fulfillment] -> IO FilePath -> IODependency_
-socketExists n ful = IOTest_ (T.unwords ["test if", n, "socket exists"]) ful
-  . io . socketExists'
+socketExists n ful =
+  IOTest_ (T.unwords ["test if", n, "socket exists"]) ful
+    . io
+    . socketExists'
 
 socketExists' :: IO FilePath -> IO (Maybe Msg)
 socketExists' getPath = do
   p <- getPath
   r <- tryIOError $ getFileStatus p
   return $ case r of
-    Left e  -> toErr $ T.pack $ ioe_description e
+    Left e -> toErr $ T.pack $ ioe_description e
     Right s -> if isSocket s then Nothing else toErr $ T.append (T.pack p) " is not a socket"
   where
     toErr = Just . Msg LevelError
 
 --------------------------------------------------------------------------------
--- | DBus Dependency Testing
+-- DBus Dependency Testing
 
 introspectInterface :: InterfaceName
 introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
@@ -814,12 +848,15 @@ testDBusDepNoCache_ :: SafeClient c => c -> DBusDependency_ c -> FIO Result_
 testDBusDepNoCache_ cl (Bus _ bus) = io $ do
   ret <- callMethod cl queryBus queryPath queryIface queryMem
   return $ case ret of
-        Left e    -> Left [Msg LevelError e]
-        Right b -> let ns = bodyGetNames b in
-          if bus' `elem` ns then Right []
-          else Left [
-            Msg LevelError $ T.unwords ["name", singleQuote bus', "not found on dbus"]
-            ]
+    Left e -> Left [Msg LevelError e]
+    Right b ->
+      let ns = bodyGetNames b
+       in if bus' `elem` ns
+            then Right []
+            else
+              Left
+                [ Msg LevelError $ T.unwords ["name", singleQuote bus', "not found on dbus"]
+                ]
   where
     bus' = T.pack $ formatBusName bus
     queryBus = busName_ "org.freedesktop.DBus"
@@ -827,76 +864,84 @@ testDBusDepNoCache_ cl (Bus _ bus) = io $ do
     queryPath = objectPath_ "/"
     queryMem = memberName_ "ListNames"
     bodyGetNames [v] = fromMaybe [] $ fromVariant v :: [T.Text]
-    bodyGetNames _   = []
-
+    bodyGetNames _ = []
 testDBusDepNoCache_ cl (Endpoint _ busname objpath iface mem) = io $ do
   ret <- callMethod cl busname objpath introspectInterface introspectMethod
   return $ case ret of
-        Left e     -> Left [Msg LevelError e]
-        Right body -> procBody body
+    Left e -> Left [Msg LevelError e]
+    Right body -> procBody body
   where
-    procBody body = let res = findMem =<< I.parseXML objpath =<< fromVariant
-                          =<< listToMaybe body in
-      case res of
-        Just True -> Right []
-        _         -> Left [Msg LevelError $ fmtMsg' mem]
-    findMem = fmap (matchMem mem)
-      . find (\i -> I.interfaceName i == iface)
-      . I.objectInterfaces
-    matchMem (Method_ n)   = elemMember n I.methodName I.interfaceMethods
-    matchMem (Signal_ n)   = elemMember n I.signalName I.interfaceSignals
+    procBody body =
+      let res =
+            findMem
+              =<< I.parseXML objpath
+              =<< fromVariant
+              =<< listToMaybe body
+       in case res of
+            Just True -> Right []
+            _ -> Left [Msg LevelError $ fmtMsg' mem]
+    findMem =
+      fmap (matchMem mem)
+        . find (\i -> I.interfaceName i == iface)
+        . I.objectInterfaces
+    matchMem (Method_ n) = elemMember n I.methodName I.interfaceMethods
+    matchMem (Signal_ n) = elemMember n I.signalName I.interfaceSignals
     matchMem (Property_ n) = elemMember n (T.pack . I.propertyName) I.interfaceProperties
     elemMember n fname fmember = elem n . fmap fname . fmember
-    fmtMem (Method_ n)   = T.unwords ["method", singleQuote (T.pack $ formatMemberName n)]
-    fmtMem (Signal_ n)   = T.unwords ["signal", singleQuote (T.pack $ formatMemberName n)]
+    fmtMem (Method_ n) = T.unwords ["method", singleQuote (T.pack $ formatMemberName n)]
+    fmtMem (Signal_ n) = T.unwords ["signal", singleQuote (T.pack $ formatMemberName n)]
     fmtMem (Property_ n) = T.unwords ["property", singleQuote n]
-    fmtMsg' m = T.unwords
-      [ "could not find"
-      , fmtMem m
-      , "on interface"
-      , singleQuote $ T.pack $ formatInterfaceName iface
-      , "on bus"
-      , T.pack $ formatBusName busname
-      ]
-
+    fmtMsg' m =
+      T.unwords
+        [ "could not find"
+        , fmtMem m
+        , "on interface"
+        , singleQuote $ T.pack $ formatInterfaceName iface
+        , "on bus"
+        , T.pack $ formatBusName busname
+        ]
 testDBusDepNoCache_ _ (DBusIO i) = testIODepNoCache_ i
 
 --------------------------------------------------------------------------------
--- | IO Lifting functions
+-- IO Lifting functions
 
 ioSometimes :: MonadIO m => Sometimes (IO a) -> Sometimes (m a)
 ioSometimes (Sometimes n t xs) = Sometimes n t $ fmap ioSubfeature xs
 
 ioAlways :: MonadIO m => Always (IO a) -> Always (m a)
-ioAlways (Always n x)   = Always n $ ioAlways' x
+ioAlways (Always n x) = Always n $ ioAlways' x
 
 ioAlways' :: MonadIO m => Always_ (IO a) -> Always_ (m a)
-ioAlways' (Always_ ar)  = Always_ $ ioFallbackRoot ar
+ioAlways' (Always_ ar) = Always_ $ ioFallbackRoot ar
 ioAlways' (Option sf a) = Option (ioSubfeature sf) $ ioAlways' a
 
 ioFallbackRoot :: MonadIO m => FallbackRoot (IO a) -> FallbackRoot (m a)
-ioFallbackRoot (FallbackAlone a)  = FallbackAlone $ io a
+ioFallbackRoot (FallbackAlone a) = FallbackAlone $ io a
 ioFallbackRoot (FallbackTree a s) = FallbackTree (io . a) s
 
 ioSubfeature :: MonadIO m => SubfeatureRoot (IO a) -> SubfeatureRoot (m a)
-ioSubfeature sf = sf { sfData = ioRoot $ sfData sf }
+ioSubfeature sf = sf {sfData = ioRoot $ sfData sf}
 
 ioRoot :: MonadIO m => Root (IO a) -> Root (m a)
-ioRoot (IORoot a t)       = IORoot (io . a) t
-ioRoot (IORoot_ a t)      = IORoot_ (io a) t
-ioRoot (DBusRoot a t cl)  = DBusRoot (\p c -> io $ a p c) t cl
+ioRoot (IORoot a t) = IORoot (io . a) t
+ioRoot (IORoot_ a t) = IORoot_ (io a) t
+ioRoot (DBusRoot a t cl) = DBusRoot (\p c -> io $ a p c) t cl
 ioRoot (DBusRoot_ a t cl) = DBusRoot_ (io . a) t cl
 
 --------------------------------------------------------------------------------
--- | Feature constructors
+-- Feature constructors
 
 sometimes1_ :: XPQuery -> T.Text -> T.Text -> Root a -> Sometimes a
-sometimes1_ x fn n t = Sometimes fn x
-  [Subfeature{ sfData = t, sfName = n }]
+sometimes1_ x fn n t =
+  Sometimes
+    fn
+    x
+    [Subfeature {sfData = t, sfName = n}]
 
 always1_ :: T.Text -> T.Text -> Root a -> a -> Always a
-always1_ fn n t x = Always fn
-  $ Option (Subfeature{ sfData = t, sfName = n }) (Always_ $ FallbackAlone x)
+always1_ fn n t x =
+  Always fn $
+    Option (Subfeature {sfData = t, sfName = n}) (Always_ $ FallbackAlone x)
 
 sometimes1 :: T.Text -> T.Text -> Root a -> Sometimes a
 sometimes1 = sometimes1_ (const True)
@@ -910,22 +955,49 @@ sometimesIO_ fn n t x = sometimes1 fn n $ IORoot_ x t
 sometimesIO :: T.Text -> T.Text -> IOTree p -> (p -> a) -> Sometimes a
 sometimesIO fn n t x = sometimes1 fn n $ IORoot x t
 
-sometimesExe :: MonadIO m => T.Text -> T.Text -> [Fulfillment] -> Bool
-  -> FilePath -> Sometimes (m ())
+sometimesExe
+  :: MonadIO m
+  => T.Text
+  -> T.Text
+  -> [Fulfillment]
+  -> Bool
+  -> FilePath
+  -> Sometimes (m ())
 sometimesExe fn n ful sys path = sometimesExeArgs fn n ful sys path []
 
-sometimesExeArgs :: MonadIO m => T.Text -> T.Text -> [Fulfillment] -> Bool
-  -> FilePath -> [T.Text] -> Sometimes (m ())
+sometimesExeArgs
+  :: MonadIO m
+  => T.Text
+  -> T.Text
+  -> [Fulfillment]
+  -> Bool
+  -> FilePath
+  -> [T.Text]
+  -> Sometimes (m ())
 sometimesExeArgs fn n ful sys path args =
   sometimesIO_ fn n (Only_ (IOSystem_ ful $ Executable sys path)) $ spawnCmd path args
 
-sometimesDBus :: SafeClient c => Maybe c -> T.Text -> T.Text
-  -> Tree_ (DBusDependency_ c) -> (c -> a) -> Sometimes a
+sometimesDBus
+  :: SafeClient c
+  => Maybe c
+  -> T.Text
+  -> T.Text
+  -> Tree_ (DBusDependency_ c)
+  -> (c -> a)
+  -> Sometimes a
 sometimesDBus c fn n t x = sometimes1 fn n $ DBusRoot_ x t c
 
-sometimesEndpoint :: (SafeClient c, MonadIO m) => T.Text -> T.Text
-  -> [Fulfillment] -> BusName -> ObjectPath -> InterfaceName -> MemberName
-  -> Maybe c -> Sometimes (m ())
+sometimesEndpoint
+  :: (SafeClient c, MonadIO m)
+  => T.Text
+  -> T.Text
+  -> [Fulfillment]
+  -> BusName
+  -> ObjectPath
+  -> InterfaceName
+  -> MemberName
+  -> Maybe c
+  -> Sometimes (m ())
 sometimesEndpoint fn name ful busname path iface mem cl =
   sometimesDBus cl fn name deps cmd
   where
@@ -933,7 +1005,7 @@ sometimesEndpoint fn name ful busname path iface mem cl =
     cmd c = io $ void $ callMethod c busname path iface mem
 
 --------------------------------------------------------------------------------
--- | Dependency Tree Constructors
+-- Dependency Tree Constructors
 
 listToAnds :: d -> [d] -> Tree_ d
 listToAnds i = foldr (And_ . Only_) (Only_ i)
@@ -945,20 +1017,20 @@ toFallback :: IODependency p -> p -> Tree IODependency d_ p
 toFallback a = Or (Only a) . Only . IOConst
 
 voidResult :: Result p -> Result_
-voidResult (Left es)               = Left es
+voidResult (Left es) = Left es
 voidResult (Right (PostPass _ ws)) = Right ws
 
 voidRead :: Result p -> Maybe Msg
-voidRead (Left [])    = Just $ Msg LevelError "unspecified error"
-voidRead (Left (e:_)) = Just e
-voidRead (Right _)    = Nothing
+voidRead (Left []) = Just $ Msg LevelError "unspecified error"
+voidRead (Left (e : _)) = Just e
+voidRead (Right _) = Nothing
 
 readResult_ :: Maybe Msg -> Result_
 readResult_ (Just w) = Left [w]
-readResult_ _        = Right []
+readResult_ _ = Right []
 
 --------------------------------------------------------------------------------
--- | IO Dependency Constructors
+-- IO Dependency Constructors
 
 exe :: Bool -> [Fulfillment] -> FilePath -> IODependency_
 exe b ful = IOSystem_ ful . Executable b
@@ -994,59 +1066,62 @@ process :: [Fulfillment] -> T.Text -> IODependency_
 process ful = IOSystem_ ful . Process
 
 --------------------------------------------------------------------------------
--- | Dependency data for JSON
+-- Dependency data for JSON
 
 type DependencyData = [Fulfillment]
 
 dataSubfeatureRoot :: SubfeatureRoot a -> DependencyData
-dataSubfeatureRoot Subfeature { sfData = r } = dataRoot r
+dataSubfeatureRoot Subfeature {sfData = r} = dataRoot r
 
 dataRoot :: Root a -> DependencyData
-dataRoot (IORoot _ t)      = dataTree  dataIODependency dataIODependency_ t
-dataRoot (IORoot_ _ t)     = dataTree_ dataIODependency_ t
-dataRoot (DBusRoot _ t _)  = dataTree dataIODependency dataDBusDependency t
+dataRoot (IORoot _ t) = dataTree dataIODependency dataIODependency_ t
+dataRoot (IORoot_ _ t) = dataTree_ dataIODependency_ t
+dataRoot (DBusRoot _ t _) = dataTree dataIODependency dataDBusDependency t
 dataRoot (DBusRoot_ _ t _) = dataTree_ dataDBusDependency t
 
-dataTree :: forall d d_ p. (forall q. d q -> DependencyData)
-  -> (d_ -> DependencyData) -> Tree d d_ p -> DependencyData
+dataTree
+  :: forall d d_ p
+   . (forall q. d q -> DependencyData)
+  -> (d_ -> DependencyData)
+  -> Tree d d_ p
+  -> DependencyData
 dataTree f f_ = go
   where
     go :: forall q. Tree d d_ q -> DependencyData
     go (And12 _ a b) = go a ++ go b
-    go (And1 a b)    = go a ++ dataTree_ f_ b
-    go (And2 a b)    = dataTree_ f_ a ++ go b
-    go (Or a _)      = go a
-    go (Only d)      = f d
+    go (And1 a b) = go a ++ dataTree_ f_ b
+    go (And2 a b) = dataTree_ f_ a ++ go b
+    go (Or a _) = go a
+    go (Only d) = f d
 
 dataTree_ :: (d_ -> DependencyData) -> Tree_ d_ -> DependencyData
 dataTree_ f_ = go
   where
     go (And_ a b) = go a ++ go b
-    go (Or_ a _)  = go a
-    go (Only_ d)  = f_ d
+    go (Or_ a _) = go a
+    go (Only_ d) = f_ d
 
 dataIODependency :: IODependency p -> DependencyData
 dataIODependency d = case d of
-  (IORead _ f _)    -> f
+  (IORead _ f _) -> f
   (IOSometimes x _) -> dumpSometimes x
-  (IOAlways x _)    -> dumpAlways x
-  _                 -> []
+  (IOAlways x _) -> dumpAlways x
+  _ -> []
 
 dataIODependency_ :: IODependency_ -> DependencyData
 dataIODependency_ d = case d of
-  (IOSystem_ f _)  -> f
-  (IOTest_ _ f _)  -> f
+  (IOSystem_ f _) -> f
+  (IOTest_ _ f _) -> f
   (IOSometimes_ x) -> dumpSometimes x
 
 dataDBusDependency :: DBusDependency_ c -> DependencyData
 dataDBusDependency d = case d of
-    (Bus f _)            -> f
-    (Endpoint f _ _ _ _) -> f
-    (DBusIO x)           -> dataIODependency_ x
+  (Bus f _) -> f
+  (Endpoint f _ _ _ _) -> f
+  (DBusIO x) -> dataIODependency_ x
 
 --------------------------------------------------------------------------------
--- | JSON formatting
+-- formatting
 
 bracket :: T.Text -> T.Text
 bracket s = T.concat ["[", s, "]"]
-
diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index 2fb2477..d4333bd 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Dmenu (Rofi) Commands
+-- Dmenu (Rofi) Commands
 
 module XMonad.Internal.Command.DMenu
   ( runCmdMenu
@@ -15,32 +15,28 @@ module XMonad.Internal.Command.DMenu
   , runBTMenu
   , runShowKeys
   , runAutorandrMenu
-  ) where
+  )
+where
 
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-
-import           DBus
-
-import           Graphics.X11.Types
-
-import qualified RIO.Text                        as T
-
-import           System.Directory
-    ( XdgDirectory (..)
-    , getXdgDirectory
-    )
-import           System.IO
-
-import           XMonad.Core                     hiding (spawn)
-import           XMonad.Internal.Command.Desktop
-import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Notify
-import           XMonad.Internal.Shell
-import           XMonad.Util.NamedActions
+import DBus
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import Graphics.X11.Types
+import qualified RIO.Text as T
+import System.Directory
+  ( XdgDirectory (..)
+  , getXdgDirectory
+  )
+import System.IO
+import XMonad.Core hiding (spawn)
+import XMonad.Internal.Command.Desktop
+import XMonad.Internal.DBus.Common
+import XMonad.Internal.Notify
+import XMonad.Internal.Shell
+import XMonad.Util.NamedActions
 
 --------------------------------------------------------------------------------
--- | DMenu executables
+-- DMenu executables
 
 myDmenuCmd :: FilePath
 myDmenuCmd = "rofi"
@@ -67,7 +63,7 @@ myClipboardManager :: FilePath
 myClipboardManager = "greenclip"
 
 --------------------------------------------------------------------------------
--- | Packages
+-- Packages
 
 dmenuPkgs :: [Fulfillment]
 dmenuPkgs = [Package Official "rofi"]
@@ -76,7 +72,7 @@ clipboardPkgs :: [Fulfillment]
 clipboardPkgs = [Package AUR "rofi-greenclip"]
 
 --------------------------------------------------------------------------------
--- | Other internal functions
+-- Other internal functions
 
 spawnDmenuCmd :: T.Text -> [T.Text] -> SometimesX
 spawnDmenuCmd n =
@@ -98,7 +94,7 @@ dmenuDep :: IODependency_
 dmenuDep = sysExe dmenuPkgs myDmenuCmd
 
 --------------------------------------------------------------------------------
--- | Exported Commands
+-- Exported Commands
 
 -- TODO test that veracrypt and friends are installed
 runDevMenu :: SometimesX
@@ -107,28 +103,38 @@ runDevMenu = sometimesIO_ "device manager" "rofi devices" t x
     t = dmenuTree $ Only_ (localExe [] myDmenuDevices)
     x = do
       c <- io $ getXdgDirectory XdgConfig "rofi/devices.dhall"
-      spawnCmd myDmenuDevices
-        $ ["-c", T.pack c]
-        ++ "--" : themeArgs "#999933"
-        ++ myDmenuMatchingArgs
+      spawnCmd myDmenuDevices $
+        ["-c", T.pack c]
+          ++ "--"
+          : themeArgs "#999933"
+          ++ myDmenuMatchingArgs
 
 -- TODO test that bluetooth interface exists
 runBTMenu :: SometimesX
-runBTMenu = Sometimes "bluetooth selector" xpfBluetooth
-  [Subfeature (IORoot_ cmd tree) "rofi bluetooth"]
+runBTMenu =
+  Sometimes
+    "bluetooth selector"
+    xpfBluetooth
+    [Subfeature (IORoot_ cmd tree) "rofi bluetooth"]
   where
-    cmd = spawnCmd myDmenuBluetooth $ "-c":themeArgs "#0044bb"
+    cmd = spawnCmd myDmenuBluetooth $ "-c" : themeArgs "#0044bb"
     tree = dmenuTree $ Only_ $ sysExe [] myDmenuBluetooth
 
 runVPNMenu :: SometimesX
-runVPNMenu = Sometimes "VPN selector" xpfVPN
-  [Subfeature (IORoot_ cmd tree) "rofi VPN"]
+runVPNMenu =
+  Sometimes
+    "VPN selector"
+    xpfVPN
+    [Subfeature (IORoot_ cmd tree) "rofi VPN"]
   where
-    cmd = spawnCmd myDmenuVPN
-      $ ["-c"] ++ themeArgs "#007766" ++ myDmenuMatchingArgs
-    tree = dmenuTree $ toAnd_ (localExe [] myDmenuVPN)
-      $ socketExists "expressVPN" []
-      $ return "/var/lib/expressvpn/expressvpnd.socket"
+    cmd =
+      spawnCmd myDmenuVPN $
+        ["-c"] ++ themeArgs "#007766" ++ myDmenuMatchingArgs
+    tree =
+      dmenuTree $
+        toAnd_ (localExe [] myDmenuVPN) $
+          socketExists "expressVPN" [] $
+            return "/var/lib/expressvpn/expressvpnd.socket"
 
 runCmdMenu :: SometimesX
 runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
@@ -140,15 +146,20 @@ runWinMenu :: SometimesX
 runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]
 
 runNetMenu :: Maybe SysClient -> SometimesX
-runNetMenu cl = Sometimes "network control menu" enabled
-  [Subfeature root "network control menu"]
+runNetMenu cl =
+  Sometimes
+    "network control menu"
+    enabled
+    [Subfeature root "network control menu"]
   where
     enabled f = xpfEthernet f || xpfWireless f || xpfVPN f
     root = DBusRoot_ cmd tree cl
     cmd _ = spawnCmd myDmenuNetworks $ themeArgs "#ff3333"
-    tree = And_ (Only_ $ Bus networkManagerPkgs networkManagerBus)
-      $ toAnd_ (DBusIO dmenuDep) $ DBusIO
-      $ sysExe [Package AUR "networkmanager-dmenu-git"] myDmenuNetworks
+    tree =
+      And_ (Only_ $ Bus networkManagerPkgs networkManagerBus) $
+        toAnd_ (DBusIO dmenuDep) $
+          DBusIO $
+            sysExe [Package AUR "networkmanager-dmenu-git"] myDmenuNetworks
 
 runAutorandrMenu :: SometimesX
 runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
@@ -157,47 +168,63 @@ runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
     tree = dmenuTree $ Only_ $ localExe [] myDmenuMonitors
 
 --------------------------------------------------------------------------------
--- | Password manager
+-- Password manager
 
 runBwMenu :: Maybe SesClient -> SometimesX
 runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd
   where
-    cmd _ = spawnCmd myDmenuPasswords
-      $ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
-    tree = And_ (Only_ $ Bus [] $ busName_ "org.rofi.bitwarden")
-      $ toAnd_ (DBusIO dmenuDep) (DBusIO $ localExe [] myDmenuPasswords)
+    cmd _ =
+      spawnCmd myDmenuPasswords $
+        ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
+    tree =
+      And_ (Only_ $ Bus [] $ busName_ "org.rofi.bitwarden") $
+        toAnd_ (DBusIO dmenuDep) (DBusIO $ localExe [] myDmenuPasswords)
 
 --------------------------------------------------------------------------------
--- | Clipboard
+-- Clipboard
 
 runClipMenu :: SometimesX
 runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
   where
     act = spawnCmd myDmenuCmd args
-    tree = listToAnds dmenuDep [ sysExe clipboardPkgs myClipboardManager
-                               , process [] $ T.pack myClipboardManager
-                               ]
-    args = [ "-modi", "\"clipboard:greenclip print\""
-           , "-show", "clipboard"
-           , "-run-command", "'{cmd}'"
-           ] ++ themeArgs "#00c44e"
+    tree =
+      listToAnds
+        dmenuDep
+        [ sysExe clipboardPkgs myClipboardManager
+        , process [] $ T.pack myClipboardManager
+        ]
+    args =
+      [ "-modi"
+      , "\"clipboard:greenclip print\""
+      , "-show"
+      , "clipboard"
+      , "-run-command"
+      , "'{cmd}'"
+      ]
+        ++ themeArgs "#00c44e"
 
 --------------------------------------------------------------------------------
--- | Shortcut menu
+-- Shortcut menu
 
 runShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
-runShowKeys = Always "keyboard menu" $ Option showKeysDMenu $ Always_
-  $ FallbackAlone fallback
+runShowKeys =
+  Always "keyboard menu" $
+    Option showKeysDMenu $
+      Always_ $
+        FallbackAlone fallback
   where
     -- TODO this should technically depend on dunst
-    fallback = const $ spawnNotify
-      $ defNoteError { body = Just $ Text "could not display keymap" }
+    fallback =
+      const $
+        spawnNotify $
+          defNoteError {body = Just $ Text "could not display keymap"}
 
 showKeysDMenu :: SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> X ())
-showKeysDMenu = Subfeature
-  { sfName = "keyboard shortcut menu"
-  , sfData = IORoot_ showKeys $ Only_ dmenuDep
-  }
+showKeysDMenu =
+  Subfeature
+    { sfName = "keyboard shortcut menu"
+    , sfData = IORoot_ showKeys $ Only_ dmenuDep
+    }
 
 showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
 showKeys kbs = do
@@ -205,5 +232,8 @@ showKeys kbs = do
   io $ hPutStr h $ unlines $ showKm kbs
   io $ hClose h
   where
-    cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
-      ++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs
+    cmd =
+      fmtCmd myDmenuCmd $
+        ["-dmenu", "-p", "commands"]
+          ++ themeArgs "#7f66ff"
+          ++ myDmenuMatchingArgs
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 6a4d00c..7efebab 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -1,12 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | General commands
+-- General commands
 
 module XMonad.Internal.Command.Desktop
   ( myTerm
   , playSound
-
   -- commands
   , runTerm
   , runTMux
@@ -33,37 +32,32 @@ module XMonad.Internal.Command.Desktop
   , runNotificationCloseAll
   , runNotificationHistory
   , runNotificationContext
-
   -- daemons
   , runNetAppDaemon
-
   -- packages
   , networkManagerPkgs
-  ) where
+  )
+where
 
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-
-import           DBus
-
-import           RIO
-import           RIO.FilePath
-import qualified RIO.Process                 as P
-import qualified RIO.Text                    as T
-
-import           System.Directory
-import           System.Environment
-import           System.Posix.User
-
-import           XMonad.Actions.Volume
-import           XMonad.Core                 hiding (spawn)
-import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Notify
-import           XMonad.Internal.Shell       as S
-import           XMonad.Operations
+import DBus
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import RIO
+import RIO.FilePath
+import qualified RIO.Process as P
+import qualified RIO.Text as T
+import System.Directory
+import System.Environment
+import System.Posix.User
+import XMonad.Actions.Volume
+import XMonad.Core hiding (spawn)
+import XMonad.Internal.DBus.Common
+import XMonad.Internal.Notify
+import XMonad.Internal.Shell as S
+import XMonad.Operations
 
 --------------------------------------------------------------------------------
--- | My Executables
+-- My Executables
 
 myTerm :: FilePath
 myTerm = "urxvt"
@@ -96,12 +90,13 @@ myNotificationCtrl :: FilePath
 myNotificationCtrl = "dunstctl"
 
 --------------------------------------------------------------------------------
--- | Packages
+-- Packages
 
 myTermPkgs :: [Fulfillment]
-myTermPkgs = [ Package Official "rxvt-unicode"
-             , Package Official "urxvt-perls"
-             ]
+myTermPkgs =
+  [ Package Official "rxvt-unicode"
+  , Package Official "urxvt-perls"
+  ]
 
 myEditorPkgs :: [Fulfillment]
 myEditorPkgs = [Package Official "emacs-nativecomp"]
@@ -116,13 +111,13 @@ networkManagerPkgs :: [Fulfillment]
 networkManagerPkgs = [Package Official "networkmanager"]
 
 --------------------------------------------------------------------------------
--- | Misc constants
+-- Misc constants
 
 volumeChangeSound :: FilePath
 volumeChangeSound = "smb_fireball.wav"
 
 --------------------------------------------------------------------------------
--- | Some nice apps
+-- Some nice apps
 
 runTerm :: SometimesX
 runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm
@@ -130,12 +125,14 @@ runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm
 runTMux :: SometimesX
 runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
   where
-    deps = listToAnds (socketExists "tmux" [] socketName)
-      $ fmap (sysExe myTermPkgs) [myTerm, "tmux", "bash"]
-    act = S.spawn
-      $ fmtCmd "tmux" ["has-session"]
-      #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
-      #!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
+    deps =
+      listToAnds (socketExists "tmux" [] socketName) $
+        fmap (sysExe myTermPkgs) [myTerm, "tmux", "bash"]
+    act =
+      S.spawn $
+        fmtCmd "tmux" ["has-session"]
+          #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
+          #!|| fmtNotifyCmd defNoteError {body = Just $ Text msg}
     c = "exec tmux attach-session -d"
     msg = "could not connect to tmux session"
     socketName = do
@@ -150,28 +147,46 @@ runCalc = sometimesIO_ "calculator" "bc" deps act
     act = spawnCmd myTerm ["-e", T.pack myCalc, "-l"]
 
 runBrowser :: SometimesX
-runBrowser = sometimesExe "web browser" "brave" [Package AUR "brave-bin"]
-  False myBrowser
+runBrowser =
+  sometimesExe
+    "web browser"
+    "brave"
+    [Package AUR "brave-bin"]
+    False
+    myBrowser
 
 runEditor :: SometimesX
 runEditor = sometimesIO_ "text editor" "emacs" tree cmd
   where
-    cmd = spawnCmd myEditor
-      ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
+    cmd =
+      spawnCmd
+        myEditor
+        ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
     -- NOTE 1: we could test if the emacs socket exists, but it won't come up
     -- before xmonad starts, so just check to see if the process has started
     tree = toAnd_ (sysExe myEditorPkgs myEditor) $ process [] $ T.pack myEditorServer
 
 runFileManager :: SometimesX
-runFileManager = sometimesExe "file browser" "pcmanfm" [Package Official "pcmanfm"]
-  True "pcmanfm"
+runFileManager =
+  sometimesExe
+    "file browser"
+    "pcmanfm"
+    [Package Official "pcmanfm"]
+    True
+    "pcmanfm"
 
 --------------------------------------------------------------------------------
--- | Multimedia Commands
+-- Multimedia Commands
 
 runMultimediaIfInstalled :: T.Text -> T.Text -> SometimesX
-runMultimediaIfInstalled n cmd = sometimesExeArgs (T.append n " multimedia control")
-  "playerctl" [Package Official "playerctl"] True myMultimediaCtl [cmd]
+runMultimediaIfInstalled n cmd =
+  sometimesExeArgs
+    (T.append n " multimedia control")
+    "playerctl"
+    [Package Official "playerctl"]
+    True
+    myMultimediaCtl
+    [cmd]
 
 runTogglePlay :: SometimesX
 runTogglePlay = runMultimediaIfInstalled "play/pause" "play-pause"
@@ -186,7 +201,7 @@ runStopPlay :: SometimesX
 runStopPlay = runMultimediaIfInstalled "stop playback" "stop"
 
 --------------------------------------------------------------------------------
--- | Volume Commands
+-- Volume Commands
 
 soundDir :: FilePath
 soundDir = "sound"
@@ -200,8 +215,8 @@ playSound file = do
 
 featureSound :: T.Text -> FilePath -> X () -> X () -> SometimesX
 featureSound n file pre post =
-  sometimesIO_ (T.unwords ["volume", n, " control"]) "paplay" tree
-  $ pre >> playSound file >> post
+  sometimesIO_ (T.unwords ["volume", n, " control"]) "paplay" tree $
+    pre >> playSound file >> post
   where
     -- ASSUME pulseaudio pulls in libpulse as a dep; pulseaudio itself is needed
     -- to play sound (duh) but libpulse is the package with the paplay binary
@@ -217,16 +232,18 @@ runVolumeMute :: SometimesX
 runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return ()
 
 --------------------------------------------------------------------------------
--- | Notification control
+-- Notification control
 
 runNotificationCmd :: T.Text -> T.Text -> Maybe SesClient -> SometimesX
 runNotificationCmd n arg cl =
   sometimesDBus cl (T.unwords [n, "control"]) "dunstctl" tree cmd
   where
     cmd _ = spawnCmd myNotificationCtrl [arg]
-    tree = toAnd_ (DBusIO $ sysExe notifyPkgs myNotificationCtrl)
-      $ Endpoint [] notifyBus notifyPath (interfaceName_ "org.dunstproject.cmd0")
-      $ Method_ $ memberName_ "NotificationAction"
+    tree =
+      toAnd_ (DBusIO $ sysExe notifyPkgs myNotificationCtrl) $
+        Endpoint [] notifyBus notifyPath (interfaceName_ "org.dunstproject.cmd0") $
+          Method_ $
+            memberName_ "NotificationAction"
 
 runNotificationClose :: Maybe SesClient -> SometimesX
 runNotificationClose = runNotificationCmd "close notification" "close"
@@ -244,47 +261,61 @@ runNotificationContext =
   runNotificationCmd "open notification context" "context"
 
 --------------------------------------------------------------------------------
--- | System commands
+-- System commands
 
 -- this is required for some vpn's to work properly with network-manager
 runNetAppDaemon :: Maybe SysClient -> Sometimes (FIO (P.Process () () ()))
-runNetAppDaemon cl = Sometimes "network applet" xpfVPN
-  [Subfeature (DBusRoot_ cmd tree cl) "NM-applet"]
+runNetAppDaemon cl =
+  Sometimes
+    "network applet"
+    xpfVPN
+    [Subfeature (DBusRoot_ cmd tree cl) "NM-applet"]
   where
     tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
     app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
     cmd _ = P.proc "nm-applet" [] (P.startProcess . P.setCreateGroup True)
 
 runToggleBluetooth :: Maybe SysClient -> SometimesX
-runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth
-  [Subfeature (DBusRoot_ cmd tree cl) "bluetoothctl"]
+runToggleBluetooth cl =
+  Sometimes
+    "bluetooth toggle"
+    xpfBluetooth
+    [Subfeature (DBusRoot_ cmd tree cl) "bluetoothctl"]
   where
     tree = And_ (Only_ $ DBusIO $ sysExe bluetoothPkgs myBluetooth) (Only_ $ Bus [] btBus)
-    cmd _ = S.spawn
-      $ fmtCmd myBluetooth ["show"]
-      #!| "grep -q \"Powered: no\""
-      #!&& "a=on"
-      #!|| "a=off"
-      #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
-      #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
+    cmd _ =
+      S.spawn $
+        fmtCmd myBluetooth ["show"]
+          #!| "grep -q \"Powered: no\""
+          #!&& "a=on"
+          #!|| "a=off"
+          #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
+          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "bluetooth powered $a"}
 
 runToggleEthernet :: SometimesX
-runToggleEthernet = Sometimes "ethernet toggle" xpfEthernet
-  [Subfeature root "nmcli"]
+runToggleEthernet =
+  Sometimes
+    "ethernet toggle"
+    xpfEthernet
+    [Subfeature root "nmcli"]
   where
-    root = IORoot cmd $ And1 (Only readEthernet) $ Only_
-      $ sysExe networkManagerPkgs "nmcli"
+    root =
+      IORoot cmd $
+        And1 (Only readEthernet) $
+          Only_ $
+            sysExe networkManagerPkgs "nmcli"
     -- TODO make this less noisy
-    cmd iface = S.spawn
-      $ fmtCmd "nmcli" ["-g", "GENERAL.STATE", "device", "show", iface]
-      #!| "grep -q disconnected"
-      #!&& "a=connect"
-      #!|| "a=disconnect"
-      #!>> fmtCmd "nmcli" ["device", "$a", iface]
-      #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed"  }
+    cmd iface =
+      S.spawn $
+        fmtCmd "nmcli" ["-g", "GENERAL.STATE", "device", "show", iface]
+          #!| "grep -q disconnected"
+          #!&& "a=connect"
+          #!|| "a=disconnect"
+          #!>> fmtCmd "nmcli" ["device", "$a", iface]
+          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "ethernet \"$a\"ed"}
 
 --------------------------------------------------------------------------------
--- | Configuration commands
+-- Configuration commands
 
 runRestart :: X ()
 runRestart = restart "xmonad" True
@@ -294,14 +325,14 @@ runRecompile :: X ()
 runRecompile = do
   -- assume that the conf directory contains a valid stack project
   confDir <- asks (cfgDir . directories)
-  spawn
-    $ fmtCmd "cd" [T.pack confDir]
-    #!&& fmtCmd "stack" ["install"]
-    #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
-    #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
+  spawn $
+    fmtCmd "cd" [T.pack confDir]
+      #!&& fmtCmd "stack" ["install"]
+      #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "compilation succeeded"}
+      #!|| fmtNotifyCmd defNoteError {body = Just $ Text "compilation failed"}
 
 --------------------------------------------------------------------------------
--- | Screen capture commands
+-- Screen capture commands
 
 getCaptureDir :: IO FilePath
 getCaptureDir = do
@@ -321,8 +352,10 @@ runFlameshot :: T.Text -> T.Text -> Maybe SesClient -> SometimesX
 runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd
   where
     cmd _ = spawnCmd myCapture [mode]
-    tree = toAnd_ (DBusIO $ sysExe [Package Official "flameshot"] myCapture)
-      $ Bus [] $ busName_ "org.flameshot.Flameshot"
+    tree =
+      toAnd_ (DBusIO $ sysExe [Package Official "flameshot"] myCapture) $
+        Bus [] $
+          busName_ "org.flameshot.Flameshot"
 
 -- TODO this will steal focus from the current window (and puts it
 -- in the root window?) ...need to fix
@@ -338,7 +371,10 @@ runScreenCapture :: Maybe SesClient -> SometimesX
 runScreenCapture = runFlameshot "screen capture" "screen"
 
 runCaptureBrowser :: SometimesX
-runCaptureBrowser = sometimesIO_ "screen capture browser" "feh"
-  (Only_ $ sysExe [Package Official "feh"] myImageBrowser) $ do
-  dir <- io getCaptureDir
-  spawnCmd myImageBrowser [T.pack dir]
+runCaptureBrowser = sometimesIO_
+  "screen capture browser"
+  "feh"
+  (Only_ $ sysExe [Package Official "feh"] myImageBrowser)
+  $ do
+    dir <- io getCaptureDir
+    spawnCmd myImageBrowser [T.pack dir]
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index f9a83b2..a26ac1f 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -1,10 +1,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Commands for controlling power
+-- Commands for controlling power
 
 module XMonad.Internal.Command.Power
-  -- commands
+-- commands
   ( runHibernate
   , runOptimusPrompt
   , runPowerOff
@@ -14,10 +14,8 @@ module XMonad.Internal.Command.Power
   , runSuspend
   , runSuspendPrompt
   , runQuitPrompt
-
   -- daemons
   , runAutolock
-
   -- functions
   , hasBattery
   , suspendPrompt
@@ -25,32 +23,27 @@ module XMonad.Internal.Command.Power
   , powerPrompt
   , defFontPkgs
   , promptFontDep
-  ) where
+  )
+where
 
-import           Data.Internal.Dependency
-
-import           Data.Either
-import qualified Data.Map                    as M
-
-import           Graphics.X11.Types
-
-import           RIO
-import           RIO.FilePath
-import qualified RIO.Process                 as P
-import qualified RIO.Text                    as T
-
-import           System.Directory
-import           System.IO.Error
-
-import           XMonad.Core                 hiding (spawn)
-import           XMonad.Internal.Shell
-import qualified XMonad.Internal.Theme       as XT
-import           XMonad.Prompt
-import           XMonad.Prompt.ConfirmPrompt
+import Data.Either
+import Data.Internal.Dependency
+import qualified Data.Map as M
+import Graphics.X11.Types
+import RIO
+import RIO.FilePath
+import qualified RIO.Process as P
+import qualified RIO.Text as T
+import System.Directory
+import System.IO.Error
+import XMonad.Core hiding (spawn)
+import XMonad.Internal.Shell
+import qualified XMonad.Internal.Theme as XT
+import XMonad.Prompt
+import XMonad.Prompt.ConfirmPrompt
 
 --------------------------------------------------------------------------------
--- | Executables
-
+-- Executables
 myScreenlock :: FilePath
 myScreenlock = "screenlock"
 
@@ -61,17 +54,22 @@ myPrimeOffload :: FilePath
 myPrimeOffload = "prime-offload"
 
 --------------------------------------------------------------------------------
--- | Packages
+-- Packages
 
 optimusPackages :: [Fulfillment]
 optimusPackages = [Package AUR "optimus-manager"]
 
 --------------------------------------------------------------------------------
--- | Core commands
+-- Core commands
 
 runScreenLock :: SometimesX
-runScreenLock = sometimesExe "screen locker" "i3lock script"
-  [Package AUR "i3lock-color"] False myScreenlock
+runScreenLock =
+  sometimesExe
+    "screen locker"
+    "i3lock script"
+    [Package AUR "i3lock-color"]
+    False
+    myScreenlock
 
 runPowerOff :: X ()
 runPowerOff = spawn "systemctl poweroff"
@@ -86,17 +84,19 @@ runReboot :: X ()
 runReboot = spawn "systemctl reboot"
 
 --------------------------------------------------------------------------------
--- | Autolock
+-- Autolock
 
 runAutolock :: Sometimes (FIO (P.Process () () ()))
 runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
   where
-    tree = And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock")
-      $ Only_ $ IOSometimes_ runScreenLock
+    tree =
+      And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock") $
+        Only_ $
+          IOSometimes_ runScreenLock
     cmd = P.proc "xss-lock" ["--ignore-sleep", "screenlock"] (P.startProcess . P.setCreateGroup True)
 
 --------------------------------------------------------------------------------
--- | Confirmation prompts
+-- Confirmation prompts
 
 promptFontDep :: IOTree XT.FontBuilder
 promptFontDep = fontTreeAlt XT.defFontFamily defFontPkgs
@@ -124,7 +124,7 @@ runQuitPrompt :: SometimesX
 runQuitPrompt = sometimesPrompt "quit prompt" quitPrompt
 
 --------------------------------------------------------------------------------
--- | Nvidia Optimus
+-- Nvidia Optimus
 
 -- TODO for some reason the screen never wakes up after suspend when
 -- the nvidia card is up, so block suspend if nvidia card is running
@@ -148,30 +148,36 @@ runOptimusPrompt' fb = do
   where
     switch mode = confirmPrompt' (prompt mode) (cmd mode) fb
     prompt mode = T.concat ["gpu switch to ", mode, "?"]
-    cmd mode = spawn
-      $ T.pack myPrimeOffload
-      #!&& T.unwords [T.pack myOptimusManager, "--switch", mode, "--no-confirm"]
-      #!&& "killall xmonad"
+    cmd mode =
+      spawn $
+        T.pack myPrimeOffload
+          #!&& T.unwords [T.pack myOptimusManager, "--switch", mode, "--no-confirm"]
+          #!&& "killall xmonad"
 
 runOptimusPrompt :: SometimesX
-runOptimusPrompt = Sometimes "graphics switcher"
-  (\x -> xpfOptimus x && xpfBattery x) [s]
+runOptimusPrompt =
+  Sometimes
+    "graphics switcher"
+    (\x -> xpfOptimus x && xpfBattery x)
+    [s]
   where
-    s = Subfeature { sfData = r, sfName = "optimus manager" }
+    s = Subfeature {sfData = r, sfName = "optimus manager"}
     r = IORoot runOptimusPrompt' t
-    t = And1 promptFontDep
-      $ listToAnds (socketExists "optimus-manager" [] socketName)
-      $ sysExe optimusPackages <$> [myOptimusManager, myPrimeOffload]
+    t =
+      And1 promptFontDep $
+        listToAnds (socketExists "optimus-manager" [] socketName) $
+          sysExe optimusPackages <$> [myOptimusManager, myPrimeOffload]
     socketName = (</> "optimus-manager") <$> getTemporaryDirectory
 
 --------------------------------------------------------------------------------
--- | Universal power prompt
+-- Universal power prompt
 
-data PowerMaybeAction = Poweroff
-    | Shutdown
-    | Hibernate
-    | Reboot
-    deriving (Eq)
+data PowerMaybeAction
+  = Poweroff
+  | Shutdown
+  | Hibernate
+  | Reboot
+  deriving (Eq)
 
 instance Enum PowerMaybeAction where
   toEnum 0 = Poweroff
@@ -180,15 +186,15 @@ instance Enum PowerMaybeAction where
   toEnum 3 = Reboot
   toEnum _ = errorWithoutStackTrace "Main.Enum.PowerMaybeAction.toEnum: bad argument"
 
-  fromEnum Poweroff  = 0
-  fromEnum Shutdown  = 1
+  fromEnum Poweroff = 0
+  fromEnum Shutdown = 1
   fromEnum Hibernate = 2
-  fromEnum Reboot    = 3
+  fromEnum Reboot = 3
 
 data PowerPrompt = PowerPrompt
 
 instance XPrompt PowerPrompt where
-    showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"
+  showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"
 
 runPowerPrompt :: SometimesX
 runPowerPrompt = Sometimes "power prompt" (const True) [sf]
@@ -202,20 +208,22 @@ powerPrompt :: X () -> XT.FontBuilder -> X ()
 powerPrompt lock fb = mkXPrompt PowerPrompt theme comp executeMaybeAction
   where
     comp = mkComplFunFromList theme []
-    theme = (XT.promptTheme fb) { promptKeymap = keymap }
-    keymap = M.fromList
-      $ ((controlMask, xK_g), quit) :
-      map (first $ (,) 0)
-      [ (xK_p, sendMaybeAction Poweroff)
-      , (xK_s, sendMaybeAction Shutdown)
-      , (xK_h, sendMaybeAction Hibernate)
-      , (xK_r, sendMaybeAction Reboot)
-      , (xK_Return, quit)
-      , (xK_Escape, quit)
-      ]
+    theme = (XT.promptTheme fb) {promptKeymap = keymap}
+    keymap =
+      M.fromList $
+        ((controlMask, xK_g), quit)
+          : map
+            (first $ (,) 0)
+            [ (xK_p, sendMaybeAction Poweroff)
+            , (xK_s, sendMaybeAction Shutdown)
+            , (xK_h, sendMaybeAction Hibernate)
+            , (xK_r, sendMaybeAction Reboot)
+            , (xK_Return, quit)
+            , (xK_Escape, quit)
+            ]
     sendMaybeAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
     executeMaybeAction a = case toEnum $ read a of
-      Poweroff  -> runPowerOff
-      Shutdown  -> lock >> runSuspend
+      Poweroff -> runPowerOff
+      Shutdown -> lock >> runSuspend
       Hibernate -> lock >> runHibernate
-      Reboot    -> runReboot
+      Reboot -> runReboot
diff --git a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
index 485ecd9..d32edee 100644
--- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
+++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
@@ -1,38 +1,37 @@
-{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Concurrent module to handle events from acpid
+-- Concurrent module to handle events from acpid
 
 module XMonad.Internal.Concurrent.ACPIEvent
   ( runPowermon
   , runHandleACPI
-  ) where
+  )
+where
 
-import           Data.Internal.Dependency
-
-import           Network.Socket
-import           Network.Socket.ByteString
-
-import           RIO
-import qualified RIO.ByteString                           as B
-
-import           XMonad.Core
-import           XMonad.Internal.Command.Power
-import           XMonad.Internal.Concurrent.ClientMessage
-import           XMonad.Internal.Shell
-import           XMonad.Internal.Theme                    (FontBuilder)
+import Data.Internal.Dependency
+import Network.Socket
+import Network.Socket.ByteString
+import RIO
+import qualified RIO.ByteString as B
+import XMonad.Core
+import XMonad.Internal.Command.Power
+import XMonad.Internal.Concurrent.ClientMessage
+import XMonad.Internal.Shell
+import XMonad.Internal.Theme (FontBuilder)
 
 --------------------------------------------------------------------------------
--- | Data structure to hold the ACPI events I care about
+-- Data structure to hold the ACPI events I care about
 --
 -- Enumerate so these can be converted to strings and back when sent in a
 -- ClientMessage event to X
 
-data ACPIEvent = Power
-    | Sleep
-    | LidClose
-    deriving (Eq)
+data ACPIEvent
+  = Power
+  | Sleep
+  | LidClose
+  deriving (Eq)
 
 instance Enum ACPIEvent where
   toEnum 0 = Power
@@ -40,24 +39,24 @@ instance Enum ACPIEvent where
   toEnum 2 = LidClose
   toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument"
 
-  fromEnum Power    = 0
-  fromEnum Sleep    = 1
+  fromEnum Power = 0
+  fromEnum Sleep = 1
   fromEnum LidClose = 2
 
 --------------------------------------------------------------------------------
--- | Internal functions
+-- Internal functions
 
 -- | Convert a string to an ACPI event (this string is assumed to come from
 -- the acpid socket)
 parseLine :: ByteString -> Maybe ACPIEvent
 parseLine line =
   case splitLine line of
-    (_:"PBTN":_)        -> Just Power
-    (_:"PWRF":_)        -> Just Power
-    (_:"SLPB":_)        -> Just Sleep
-    (_:"SBTN":_)        -> Just Sleep
-    (_:"LID":"close":_) -> Just LidClose
-    _                   -> Nothing
+    (_ : "PBTN" : _) -> Just Power
+    (_ : "PWRF" : _) -> Just Power
+    (_ : "SLPB" : _) -> Just Sleep
+    (_ : "SBTN" : _) -> Just Sleep
+    (_ : "LID" : "close" : _) -> Just LidClose
+    _ -> Nothing
   where
     splitLine = B.split space . B.reverse . B.dropWhile (== newline) . B.reverse
     newline = 10
@@ -71,7 +70,7 @@ isDischarging :: IO (Maybe Bool)
 isDischarging = do
   status <- tryIO $ B.readFile "/sys/class/power_supply/BAT0/status"
   case status of
-    Left _  -> return Nothing
+    Left _ -> return Nothing
     Right s -> return $ Just (s == "Discharging")
 
 listenACPI :: IO ()
@@ -103,7 +102,7 @@ handleACPI fb lock tag = do
       lock
 
 --------------------------------------------------------------------------------
--- | Exported API
+-- Exported API
 
 -- | Spawn a new thread that will listen for ACPI events on the acpid socket
 -- and send ClientMessage events when it receives them
@@ -114,7 +113,9 @@ runHandleACPI :: Always (String -> X ())
 runHandleACPI = Always "ACPI event handler" $ Option sf fallback
   where
     sf = Subfeature withLock "acpid prompt"
-    withLock = IORoot (uncurry handleACPI)
-      $ And12 (,) promptFontDep $ Only
-      $ IOSometimes runScreenLock id
+    withLock =
+      IORoot (uncurry handleACPI) $
+        And12 (,) promptFontDep $
+          Only $
+            IOSometimes runScreenLock id
     fallback = Always_ $ FallbackAlone $ const skip
diff --git a/lib/XMonad/Internal/Concurrent/ClientMessage.hs b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
index d5ee052..37e85c9 100644
--- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs
+++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
@@ -1,5 +1,5 @@
 --------------------------------------------------------------------------------
--- | Core ClientMessage module to 'achieve' concurrency in XMonad
+-- Core ClientMessage module to 'achieve' concurrency in XMonad
 --
 -- Since XMonad is single threaded, the only way to have multiple threads that
 -- listen/react to non-X events is to spawn other threads the run outside of
@@ -16,50 +16,50 @@
 -- much like something from X even though it isn't
 
 module XMonad.Internal.Concurrent.ClientMessage
-  ( XMsgType(..)
+  ( XMsgType (..)
   , sendXMsg
   , splitXMsg
-  ) where
+  )
+where
 
-import           Data.Char
-
-import           Graphics.X11.Types
-import           Graphics.X11.Xlib.Atom
-import           Graphics.X11.Xlib.Display
-import           Graphics.X11.Xlib.Event
-import           Graphics.X11.Xlib.Extras
-import           Graphics.X11.Xlib.Types
-
-import           RIO                       hiding (Display)
+import Data.Char
+import Graphics.X11.Types
+import Graphics.X11.Xlib.Atom
+import Graphics.X11.Xlib.Display
+import Graphics.X11.Xlib.Event
+import Graphics.X11.Xlib.Extras
+import Graphics.X11.Xlib.Types
+import RIO hiding (Display)
 
 --------------------------------------------------------------------------------
--- | Data structure for the ClientMessage
+-- Data structure for the ClientMessage
 --
 -- These are the "types" of client messages to send; add more here as needed
 
 -- TODO is there a way to do this in the libraries that import this one?
-data XMsgType = ACPI
-    | Workspace
-    | Unknown
-    deriving (Eq, Show)
+data XMsgType
+  = ACPI
+  | Workspace
+  | Unknown
+  deriving (Eq, Show)
 
 instance Enum XMsgType where
   toEnum 0 = ACPI
   toEnum 1 = Workspace
   toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument"
 
-  fromEnum ACPI      = 0
+  fromEnum ACPI = 0
   fromEnum Workspace = 1
-  fromEnum Unknown   = 2
+  fromEnum Unknown = 2
 
 --------------------------------------------------------------------------------
--- | Exported API
+-- Exported API
 
 -- | Given a string from the data field in a ClientMessage event, return the
 -- type and payload
 splitXMsg :: (Integral a) => [a] -> (XMsgType, String)
 splitXMsg [] = (Unknown, "")
-splitXMsg (x:xs) = (xtype, tag)
+splitXMsg (x : xs) = (xtype, tag)
   where
     xtype = toEnum $ fromIntegral x
     tag = chr . fromIntegral <$> takeWhile (/= 0) xs
@@ -91,7 +91,7 @@ sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
     -- longer will be clipped to 19, and anything less than 19 will be padded
     -- with 0 (note this used to be random garbage before). See this function
     -- for more details.
-    setClientMessageEvent' e root bITMAP 8 (x:t)
+    setClientMessageEvent' e root bITMAP 8 (x : t)
     sendEvent dpy root False substructureNotifyMask e
   where
     x = fromIntegral $ fromEnum xtype
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index 4944611..d5e1c13 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -1,5 +1,5 @@
 --------------------------------------------------------------------------------
--- | Automatically Manage Dynamic Workspaces
+-- Automatically Manage Dynamic Workspaces
 -- This is a somewhat convoluted wrapper for the Dymamic Workspaces module
 -- in the contrib library. The general behavior this allows:
 -- 1) launch app
@@ -24,72 +24,66 @@
 -- 3) Virtualbox (should always be by itself anyways)
 
 module XMonad.Internal.Concurrent.DynamicWorkspaces
-  ( DynWorkspace(..)
+  ( DynWorkspace (..)
   , appendShift
   , appendViewShift
   , removeDynamicWorkspace
   , runWorkspaceMon
   , spawnOrSwitch
   , doSink
-  ) where
-
-import           Data.List                                (deleteBy, find)
-import qualified Data.Map                                 as M
-import           Data.Maybe
+  )
+where
 
 -- import           Control.Concurrent
-import           Control.Monad
-import           Control.Monad.Reader
-
-
-import           Graphics.X11.Types
-
-import           Graphics.X11.Xlib.Atom
-import           Graphics.X11.Xlib.Display
-import           Graphics.X11.Xlib.Event
-import           Graphics.X11.Xlib.Extras
-import           Graphics.X11.Xlib.Misc
-import           Graphics.X11.Xlib.Types
-
-import           RIO                                      hiding
-    ( Display
-    , display
-    )
-import qualified RIO.Set                                  as S
-
-import           System.Process
-
-import           XMonad.Actions.DynamicWorkspaces
-import           XMonad.Core
-    ( ManageHook
-    , WorkspaceId
-    , X
-    , io
-    , withWindowSet
-    )
-import           XMonad.Hooks.ManageHelpers               (MaybeManageHook)
-import           XMonad.Internal.Concurrent.ClientMessage
-import           XMonad.Internal.IO
-import           XMonad.ManageHook
-import           XMonad.Operations
-import qualified XMonad.StackSet                          as W
+import Control.Monad
+import Control.Monad.Reader
+import Data.List (deleteBy, find)
+import qualified Data.Map as M
+import Data.Maybe
+import Graphics.X11.Types
+import Graphics.X11.Xlib.Atom
+import Graphics.X11.Xlib.Display
+import Graphics.X11.Xlib.Event
+import Graphics.X11.Xlib.Extras
+import Graphics.X11.Xlib.Misc
+import Graphics.X11.Xlib.Types
+import RIO hiding
+  ( Display
+  , display
+  )
+import qualified RIO.Set as S
+import System.Process
+import XMonad.Actions.DynamicWorkspaces
+import XMonad.Core
+  ( ManageHook
+  , WorkspaceId
+  , X
+  , io
+  , withWindowSet
+  )
+import XMonad.Hooks.ManageHelpers (MaybeManageHook)
+import XMonad.Internal.Concurrent.ClientMessage
+import XMonad.Internal.IO
+import XMonad.ManageHook
+import XMonad.Operations
+import qualified XMonad.StackSet as W
 
 --------------------------------------------------------------------------------
--- | Dynamic Workspace datatype
--- This hold all the data needed to tie an app to a particular dynamic workspace
+-- Dynamic Workspace datatype
+-- This holds all the data needed to tie an app to a particular dynamic workspace
 
 data DynWorkspace = DynWorkspace
-    { dwName  :: String
-    , dwTag   :: WorkspaceId
-    , dwClass :: String
-    , dwHook  :: [MaybeManageHook]
-    , dwKey   :: Char
-    , dwCmd   :: Maybe (X ())
-    -- TODO this should also have the layout for this workspace
-    }
+  { dwName :: String
+  , dwTag :: WorkspaceId
+  , dwClass :: String
+  , dwHook :: [MaybeManageHook]
+  , dwKey :: Char
+  , dwCmd :: Maybe (X ())
+  -- TODO this should also have the layout for this workspace
+  }
 
 --------------------------------------------------------------------------------
--- | Manager thread
+-- Manager thread
 -- The main thread that watches for new windows. When a match is found, this
 -- thread spawns a new thread the waits for the PID of the window to exit. When
 -- the PID exits, it sends a ClientMessage event to X
@@ -99,10 +93,10 @@ data DynWorkspace = DynWorkspace
 -- type MatchTags = M.Map String String
 
 data WConf = WConf
-    { display       :: Display
-    , dynWorkspaces :: [DynWorkspace]
-    , curPIDs       :: MVar (S.Set Pid)
-    }
+  { display :: Display
+  , dynWorkspaces :: [DynWorkspace]
+  , curPIDs :: MVar (S.Set Pid)
+  }
 
 type W a = RIO WConf ()
 
@@ -120,51 +114,56 @@ runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
   where
     withEvents dpy e = do
       ps <- newMVar S.empty
-      let c = WConf { display = dpy, dynWorkspaces = dws, curPIDs = ps }
-      runRIO c
-        $ forever
-        $ handleEvent =<< io (nextEvent dpy e >> getEvent e)
+      let c = WConf {display = dpy, dynWorkspaces = dws, curPIDs = ps}
+      runRIO c $
+        forever $
+          handleEvent =<< io (nextEvent dpy e >> getEvent e)
 
 handleEvent :: Event -> W ()
 
 -- | assume this fires at least once when a new window is created (also could
 -- use CreateNotify but that is really noisy)
-handleEvent MapNotifyEvent { ev_window = w } = do
+handleEvent MapNotifyEvent {ev_window = w} = do
   dpy <- asks display
   hint <- io $ getClassHint dpy w
   dws <- asks dynWorkspaces
-  let tag = M.lookup (resClass hint)
-            $ M.fromList
-            $ fmap (\DynWorkspace { dwTag = t, dwClass = c } -> (c, t)) dws
+  let tag =
+        M.lookup (resClass hint) $
+          M.fromList $
+            fmap (\DynWorkspace {dwTag = t, dwClass = c} -> (c, t)) dws
   forM_ tag $ \t -> do
     a <- io $ internAtom dpy "_NET_WM_PID" False
     pid <- io $ getWindowProperty32 dpy a w
     case pid of
       -- ASSUMPTION windows will only have one PID at one time
       Just [p] -> let p' = fromIntegral p in void $ async $ withUniquePid p' t
-      _        -> return ()
-
+      _ -> return ()
 handleEvent _ = return ()
 
 withUniquePid :: Pid -> String -> W ()
 withUniquePid pid tag = do
   ps <- asks curPIDs
   pids <- readMVar ps
-  io $ unless (pid `elem` pids) $ bracket_
-    (modifyMVar_ ps (return . S.insert pid))
-    (modifyMVar_ ps (return . S.delete pid))
+  io
+    $ unless (pid `elem` pids)
+    $ bracket_
+      (modifyMVar_ ps (return . S.insert pid))
+      (modifyMVar_ ps (return . S.delete pid))
     $ waitUntilExit pid >> sendXMsg Workspace tag
 
 --------------------------------------------------------------------------------
--- | Launching apps
+-- Launching apps
 -- When launching apps on dymamic workspaces, first check if they are running
 -- and launch if not, then switch to their workspace
-
 wsOccupied :: Eq a1 => a1 -> W.StackSet a1 l a2 sid sd -> Bool
-wsOccupied tag ws = elem tag $ map W.tag $ filter (isJust . W.stack)
-  -- list of all workspaces with windows on them
-  -- TODO is there not a better way to do this?
-  $ W.workspace (W.current ws) : W.hidden ws ++ map W.workspace (W.visible ws)
+wsOccupied tag ws =
+  elem tag $
+    map W.tag $
+      filter (isJust . W.stack)
+      -- list of all workspaces with windows on them
+      -- TODO is there not a better way to do this?
+      $
+        W.workspace (W.current ws) : W.hidden ws ++ map W.workspace (W.visible ws)
 
 spawnOrSwitch :: WorkspaceId -> X () -> X ()
 spawnOrSwitch tag cmd = do
@@ -172,7 +171,7 @@ spawnOrSwitch tag cmd = do
   if occupied then windows $ W.view tag else cmd
 
 --------------------------------------------------------------------------------
--- | Managehook
+-- Managehook
 -- Move windows to new workspace if they are part of a dynamic workspace
 
 -- shamelessly ripped off from appendWorkspace (this analogue doesn't exist)
@@ -193,29 +192,31 @@ appendViewShift tag = liftX (appendWorkspace tag) >> viewShift tag
 -- TODO surprisingly this doesn't exist? We shouldn't need to TBH
 doSink :: ManageHook
 doSink = doF $ \s -> case W.stack $ W.workspace $ W.current s of
-                       Just s' -> W.sink (W.focus s') s
-                       Nothing -> s
+  Just s' -> W.sink (W.focus s') s
+  Nothing -> s
 
 --------------------------------------------------------------------------------
--- | Eventhook
+-- Eventhook
+
 -- When an app is closed, this will respond the event that is sent in the main
 -- XMonad thread
-
 removeDynamicWorkspace :: WorkspaceId -> X ()
 removeDynamicWorkspace target = windows removeIfEmpty
   where
     -- remove workspace if it is empty and if there are hidden workspaces
-    removeIfEmpty s@W.StackSet { W.visible = vis, W.hidden = hall@(h:hs) }
+    removeIfEmpty s@W.StackSet {W.visible = vis, W.hidden = hall@(h : hs)}
       -- if hidden, delete from hidden
-      | Just x <- find isEmptyTarget hall
-      = s { W.hidden = deleteBy (eq W.tag) x hall }
+      | Just x <- find isEmptyTarget hall =
+          s {W.hidden = deleteBy (eq W.tag) x hall}
       -- if visible, delete from visible and move first hidden to its place
-      | Just x <- find (isEmptyTarget . W.workspace) vis
-      = s { W.visible = x { W.workspace = h } : deleteBy (eq W.screen) x vis
-          , W.hidden = hs }
+      | Just x <- find (isEmptyTarget . W.workspace) vis =
+          s
+            { W.visible = x {W.workspace = h} : deleteBy (eq W.screen) x vis
+            , W.hidden = hs
+            }
       -- if current, move the first hidden workspace to the current
-      | isEmptyTarget $ W.workspace $ W.current s
-      = s { W.current = (W.current s) { W.workspace = h }, W.hidden = hs }
+      | isEmptyTarget $ W.workspace $ W.current s =
+          s {W.current = (W.current s) {W.workspace = h}, W.hidden = hs}
       -- otherwise do nothing
       | otherwise = s
     removeIfEmpty s = s
diff --git a/lib/XMonad/Internal/Concurrent/VirtualBox.hs b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
index 7d1f857..6940e60 100644
--- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs
+++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
@@ -1,25 +1,23 @@
-{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 --------------------------------------------------------------------------------
--- | VirtualBox-specific functions
+-- VirtualBox-specific functions
 
 module XMonad.Internal.Concurrent.VirtualBox
   ( vmExists
   , vmInstanceConfig
   , qual
-  ) where
+  )
+where
 
-import           Data.Internal.Dependency
-
-import           Text.XML.Light
-
-import           RIO                      hiding (try)
-import           RIO.Directory
-import           RIO.FilePath
-import qualified RIO.Text                 as T
-
-import           XMonad.Internal.Shell
+import Data.Internal.Dependency
+import RIO hiding (try)
+import RIO.Directory
+import RIO.FilePath
+import qualified RIO.Text as T
+import Text.XML.Light
+import XMonad.Internal.Shell
 
 vmExists :: T.Text -> IO (Maybe Msg)
 vmExists vm = either (Just . Msg LevelError) (const Nothing) <$> vmInstanceConfig vm
@@ -32,7 +30,7 @@ vmInstanceConfig vmName = do
     findInstance dir = do
       res <- findFile [dir] path
       return $ case res of
-        Just p  -> Right p
+        Just p -> Right p
         Nothing -> Left $ T.append "could not find VM instance: " $ singleQuote vmName
 
 vmDirectory :: IO (Either String String)
@@ -41,15 +39,17 @@ vmDirectory = do
   s <- tryIO $ readFile p
   return $ case s of
     (Left _) -> Left "could not read VirtualBox config file"
-    (Right x) -> maybe (Left "Could not parse VirtualBox config file") Right
-                 $ findDir =<< parseXMLDoc x
+    (Right x) ->
+      maybe (Left "Could not parse VirtualBox config file") Right $
+        findDir =<< parseXMLDoc x
   where
-    findDir e = findAttr (unqual "defaultMachineFolder")
-      =<< findChild (qual e "SystemProperties")
-      =<< findChild (qual e "Global") e
+    findDir e =
+      findAttr (unqual "defaultMachineFolder")
+        =<< findChild (qual e "SystemProperties")
+        =<< findChild (qual e "Global") e
 
 qual :: Element -> String -> QName
-qual e n = (elName e) { qName = n }
+qual e n = (elName e) {qName = n}
 
 vmConfig :: IO FilePath
 vmConfig = getXdgDirectory XdgConfig "VirtualBox/VirtualBox.xml"
diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
index 3395f4b..c673898 100644
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | DBus module for Clevo Keyboard control
+-- DBus module for Clevo Keyboard control
 
 module XMonad.Internal.DBus.Brightness.ClevoKeyboard
   ( callGetBrightnessCK
@@ -10,24 +10,21 @@ module XMonad.Internal.DBus.Brightness.ClevoKeyboard
   , clevoKeyboardControls
   , clevoKeyboardSignalDep
   , blPath
-  ) where
+  )
+where
 
-import           Control.Monad                          (when)
-
-import           Data.Int                               (Int32)
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-
-import           DBus
-
-import           RIO.FilePath
-
-import           XMonad.Internal.DBus.Brightness.Common
-import           XMonad.Internal.IO
+import Control.Monad (when)
+import DBus
+import Data.Int (Int32)
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import RIO.FilePath
+import XMonad.Internal.DBus.Brightness.Common
+import XMonad.Internal.IO
 
 --------------------------------------------------------------------------------
--- | Low level sysfs functions
---
+-- Low level sysfs functions
+
 type Brightness = Float
 
 type RawBrightness = Int32
@@ -84,7 +81,7 @@ decBrightness bounds = do
   return b
 
 --------------------------------------------------------------------------------
--- | DBus interface
+-- DBus interface
 
 blPath :: ObjectPath
 blPath = objectPath_ "/clevo_keyboard"
@@ -93,21 +90,22 @@ interface :: InterfaceName
 interface = interfaceName_ "org.xmonad.Brightness"
 
 clevoKeyboardConfig :: BrightnessConfig RawBrightness Brightness
-clevoKeyboardConfig = BrightnessConfig
-  { bcMin = minBrightness
-  , bcMax = maxBrightness
-  , bcInc = incBrightness
-  , bcDec = decBrightness
-  , bcGet = getBrightness
-  , bcGetMax = return maxRawBrightness
-  , bcMinRaw = minRawBrightness
-  , bcPath = blPath
-  , bcInterface = interface
-  , bcName = "Clevo keyboard"
-  }
+clevoKeyboardConfig =
+  BrightnessConfig
+    { bcMin = minBrightness
+    , bcMax = maxBrightness
+    , bcInc = incBrightness
+    , bcDec = decBrightness
+    , bcGet = getBrightness
+    , bcGetMax = return maxRawBrightness
+    , bcMinRaw = minRawBrightness
+    , bcPath = blPath
+    , bcInterface = interface
+    , bcName = "Clevo keyboard"
+    }
 
 --------------------------------------------------------------------------------
--- | Exported haskell API
+-- Exported haskell API
 
 stateFileDep :: IODependency_
 stateFileDep = pathRW stateFile [Package AUR "tuxedo-keyboard"]
@@ -119,8 +117,12 @@ clevoKeyboardSignalDep :: DBusDependency_ SesClient
 clevoKeyboardSignalDep = signalDep clevoKeyboardConfig
 
 exportClevoKeyboard :: Maybe SesClient -> SometimesIO
-exportClevoKeyboard = brightnessExporter xpfClevoBacklight []
-  [stateFileDep, brightnessFileDep] clevoKeyboardConfig
+exportClevoKeyboard =
+  brightnessExporter
+    xpfClevoBacklight
+    []
+    [stateFileDep, brightnessFileDep]
+    clevoKeyboardConfig
 
 clevoKeyboardControls :: Maybe SesClient -> BrightnessControls
 clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 8146055..e767c77 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -1,35 +1,32 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | DBus module for DBus brightness controls
+-- DBus module for DBus brightness controls
 
 module XMonad.Internal.DBus.Brightness.Common
-  ( BrightnessConfig(..)
-  , BrightnessControls(..)
+  ( BrightnessConfig (..)
+  , BrightnessControls (..)
   , brightnessControls
   , brightnessExporter
   , callGetBrightness
   , matchSignal
   , signalDep
-  ) where
+  )
+where
 
-import           Control.Monad               (void)
-
-import           Data.Int                    (Int32)
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-
-import           DBus
-import           DBus.Client
-import qualified DBus.Introspection          as I
-
-import qualified RIO.Text                    as T
-
-import           XMonad.Core                 (io)
-import           XMonad.Internal.DBus.Common
+import Control.Monad (void)
+import DBus
+import DBus.Client
+import qualified DBus.Introspection as I
+import Data.Int (Int32)
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import qualified RIO.Text as T
+import XMonad.Core (io)
+import XMonad.Internal.DBus.Common
 
 --------------------------------------------------------------------------------
--- | External API
+-- External API
 --
 -- Define four methods to increase, decrease, maximize, or minimize the
 -- brightness. These methods will all return the current brightness as a 32-bit
@@ -37,16 +34,16 @@ import           XMonad.Internal.DBus.Common
 -- is one method to get the current brightness.
 
 data BrightnessConfig a b = BrightnessConfig
-  { bcMin       :: (a, a) -> IO b
-  , bcMax       :: (a, a) -> IO b
-  , bcDec       :: (a, a) -> IO b
-  , bcInc       :: (a, a) -> IO b
-  , bcGet       :: (a, a) -> IO b
-  , bcMinRaw    :: a
-  , bcGetMax    :: IO a
-  , bcPath      :: ObjectPath
+  { bcMin :: (a, a) -> IO b
+  , bcMax :: (a, a) -> IO b
+  , bcDec :: (a, a) -> IO b
+  , bcInc :: (a, a) -> IO b
+  , bcGet :: (a, a) -> IO b
+  , bcMinRaw :: a
+  , bcGetMax :: IO a
+  , bcPath :: ObjectPath
   , bcInterface :: InterfaceName
-  , bcName      :: T.Text
+  , bcName :: T.Text
   }
 
 data BrightnessControls = BrightnessControls
@@ -56,46 +53,63 @@ data BrightnessControls = BrightnessControls
   , bctlDec :: SometimesX
   }
 
-brightnessControls :: XPQuery -> BrightnessConfig a b -> Maybe SesClient
+brightnessControls
+  :: XPQuery
+  -> BrightnessConfig a b
+  -> Maybe SesClient
   -> BrightnessControls
 brightnessControls q bc cl =
   BrightnessControls
-  { bctlMax = cb "max brightness" memMax
-  , bctlMin = cb "min brightness" memMin
-  , bctlInc = cb "increase brightness" memInc
-  , bctlDec = cb "decrease brightness" memDec
-  }
+    { bctlMax = cb "max brightness" memMax
+    , bctlMin = cb "min brightness" memMin
+    , bctlInc = cb "increase brightness" memInc
+    , bctlDec = cb "decrease brightness" memDec
+    }
   where
     cb = callBacklight q cl bc
 
-callGetBrightness :: (SafeClient c, Num n) => BrightnessConfig a b -> c
+callGetBrightness
+  :: (SafeClient c, Num n)
+  => BrightnessConfig a b
+  -> c
   -> IO (Maybe n)
-callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } client =
+callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} client =
   either (const Nothing) bodyGetBrightness
-  <$> callMethod client xmonadBusName p i memGet
+    <$> callMethod client xmonadBusName p i memGet
 
 signalDep :: BrightnessConfig a b -> DBusDependency_ SesClient
-signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
+signalDep BrightnessConfig {bcPath = p, bcInterface = i} =
   Endpoint [] xmonadBusName p i $ Signal_ memCur
 
-matchSignal :: (SafeClient c, Num n) => BrightnessConfig a b
-  -> (Maybe n-> IO ()) -> c -> IO ()
-matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb =
+matchSignal
+  :: (SafeClient c, Num n)
+  => BrightnessConfig a b
+  -> (Maybe n -> IO ())
+  -> c
+  -> IO ()
+matchSignal BrightnessConfig {bcPath = p, bcInterface = i} cb =
   void . addMatchCallback brMatcher (cb . bodyGetBrightness)
   where
     -- TODO add busname to this
-    brMatcher = matchAny
-      { matchPath = Just p
-      , matchInterface = Just i
-      , matchMember = Just memCur
-      }
+    brMatcher =
+      matchAny
+        { matchPath = Just p
+        , matchInterface = Just i
+        , matchMember = Just memCur
+        }
 
 --------------------------------------------------------------------------------
--- | Internal DBus Crap
+-- Internal DBus Crap
 
-brightnessExporter :: RealFrac b => XPQuery -> [Fulfillment] -> [IODependency_]
-  -> BrightnessConfig a b -> Maybe SesClient -> SometimesIO
-brightnessExporter q ful deps bc@BrightnessConfig { bcName = n } cl =
+brightnessExporter
+  :: RealFrac b
+  => XPQuery
+  -> [Fulfillment]
+  -> [IODependency_]
+  -> BrightnessConfig a b
+  -> Maybe SesClient
+  -> SometimesIO
+brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
   Sometimes (T.append n " DBus Interface") q [Subfeature root "exporter"]
   where
     root = DBusRoot_ (exportBrightnessControls' bc) tree cl
@@ -108,51 +122,66 @@ exportBrightnessControls' bc cl = io $ do
   let bounds = (bcMinRaw bc, maxval)
   let autoMethod' m f = autoMethod m $ emitBrightness bc ses =<< f bc bounds
   let funget = bcGet bc
-  export ses (bcPath bc) defaultInterface
-    { interfaceName = bcInterface bc
-    , interfaceMethods =
-      [ autoMethod' memMax bcMax
-      , autoMethod' memMin bcMin
-      , autoMethod' memInc bcInc
-      , autoMethod' memDec bcDec
-      , autoMethod memGet (round <$> funget bounds :: IO Int32)
-      ]
-    , interfaceSignals = [sig]
-    }
-  where
-    sig = I.Signal
-      { I.signalName = memCur
-      , I.signalArgs =
-        [
-          I.SignalArg
-          { I.signalArgName = "brightness"
-          , I.signalArgType = TypeInt32
-          }
-        ]
+  export
+    ses
+    (bcPath bc)
+    defaultInterface
+      { interfaceName = bcInterface bc
+      , interfaceMethods =
+          [ autoMethod' memMax bcMax
+          , autoMethod' memMin bcMin
+          , autoMethod' memInc bcInc
+          , autoMethod' memDec bcDec
+          , autoMethod memGet (round <$> funget bounds :: IO Int32)
+          ]
+      , interfaceSignals = [sig]
       }
+  where
+    sig =
+      I.Signal
+        { I.signalName = memCur
+        , I.signalArgs =
+            [ I.SignalArg
+                { I.signalArgName = "brightness"
+                , I.signalArgType = TypeInt32
+                }
+            ]
+        }
 
 emitBrightness :: RealFrac b => BrightnessConfig a b -> Client -> b -> IO ()
-emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
-  emit client $ sig { signalBody = [toVariant (round cur :: Int32)] }
+emitBrightness BrightnessConfig {bcPath = p, bcInterface = i} client cur =
+  emit client $ sig {signalBody = [toVariant (round cur :: Int32)]}
   where
     sig = signal p i memCur
 
-callBacklight :: XPQuery -> Maybe SesClient -> BrightnessConfig a b -> T.Text
-  -> MemberName -> SometimesX
-callBacklight q cl BrightnessConfig { bcPath = p
-                                    , bcInterface = i
-                                    , bcName = n } controlName m =
-  Sometimes (T.unwords [n, controlName]) q [Subfeature root "method call"]
-  where
-    root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
-    cmd c = io $ void $ callMethod c xmonadBusName p i m
+callBacklight
+  :: XPQuery
+  -> Maybe SesClient
+  -> BrightnessConfig a b
+  -> T.Text
+  -> MemberName
+  -> SometimesX
+callBacklight
+  q
+  cl
+  BrightnessConfig
+    { bcPath = p
+    , bcInterface = i
+    , bcName = n
+    }
+  controlName
+  m =
+    Sometimes (T.unwords [n, controlName]) q [Subfeature root "method call"]
+    where
+      root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
+      cmd c = io $ void $ callMethod c xmonadBusName p i m
 
 bodyGetBrightness :: Num a => [Variant] -> Maybe a
 bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
-bodyGetBrightness _   = Nothing
+bodyGetBrightness _ = Nothing
 
 --------------------------------------------------------------------------------
--- | DBus Members
+-- DBus Members
 
 memCur :: MemberName
 memCur = memberName_ "CurrentBrightness"
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index 9c29cae..21a3f94 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | DBus module for Intel Backlight control
+-- DBus module for Intel Backlight control
 
 module XMonad.Internal.DBus.Brightness.IntelBacklight
   ( callGetBrightnessIB
@@ -10,22 +10,20 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
   , intelBacklightControls
   , intelBacklightSignalDep
   , blPath
-  ) where
+  )
+where
 
-import           Data.Int                               (Int32)
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-
-import           DBus
-
-import           RIO.FilePath
-
-import           XMonad.Internal.DBus.Brightness.Common
-import           XMonad.Internal.IO
+import DBus
+import Data.Int (Int32)
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import RIO.FilePath
+import XMonad.Internal.DBus.Brightness.Common
+import XMonad.Internal.IO
 
 --------------------------------------------------------------------------------
--- | Low level sysfs functions
---
+-- Low level sysfs functions
+
 type Brightness = Float
 
 type RawBrightness = Int32
@@ -66,7 +64,7 @@ decBrightness :: RawBounds -> IO Brightness
 decBrightness = decPercent steps curFile
 
 --------------------------------------------------------------------------------
--- | DBus interface
+-- DBus interface
 
 blPath :: ObjectPath
 blPath = objectPath_ "/intelbacklight"
@@ -75,21 +73,22 @@ interface :: InterfaceName
 interface = interfaceName_ "org.xmonad.Brightness"
 
 intelBacklightConfig :: BrightnessConfig RawBrightness Brightness
-intelBacklightConfig = BrightnessConfig
-  { bcMin = minBrightness
-  , bcMax = maxBrightness
-  , bcInc = incBrightness
-  , bcDec = decBrightness
-  , bcGet = getBrightness
-  , bcGetMax = getMaxRawBrightness
-  , bcMinRaw = minRawBrightness
-  , bcPath = blPath
-  , bcInterface = interface
-  , bcName = "Intel backlight"
-  }
+intelBacklightConfig =
+  BrightnessConfig
+    { bcMin = minBrightness
+    , bcMax = maxBrightness
+    , bcInc = incBrightness
+    , bcDec = decBrightness
+    , bcGet = getBrightness
+    , bcGetMax = getMaxRawBrightness
+    , bcMinRaw = minRawBrightness
+    , bcPath = blPath
+    , bcInterface = interface
+    , bcName = "Intel backlight"
+    }
 
 --------------------------------------------------------------------------------
--- | Exported haskell API
+-- Exported haskell API
 
 curFileDep :: IODependency_
 curFileDep = pathRW curFile []
@@ -101,8 +100,12 @@ intelBacklightSignalDep :: DBusDependency_ SesClient
 intelBacklightSignalDep = signalDep intelBacklightConfig
 
 exportIntelBacklight :: Maybe SesClient -> SometimesIO
-exportIntelBacklight = brightnessExporter xpfIntelBacklight []
-  [curFileDep, maxFileDep] intelBacklightConfig
+exportIntelBacklight =
+  brightnessExporter
+    xpfIntelBacklight
+    []
+    [curFileDep, maxFileDep]
+    intelBacklightConfig
 
 intelBacklightControls :: Maybe SesClient -> BrightnessControls
 intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig
diff --git a/lib/XMonad/Internal/DBus/Common.hs b/lib/XMonad/Internal/DBus/Common.hs
index 4fb4b0a..65c6006 100644
--- a/lib/XMonad/Internal/DBus/Common.hs
+++ b/lib/XMonad/Internal/DBus/Common.hs
@@ -1,5 +1,5 @@
 --------------------------------------------------------------------------------
--- | High-level interface for managing XMonad's DBus
+-- High-level interface for managing XMonad's DBus
 
 module XMonad.Internal.DBus.Common
   ( xmonadBusName
@@ -7,9 +7,10 @@ module XMonad.Internal.DBus.Common
   , notifyBus
   , notifyPath
   , networkManagerBus
-  ) where
+  )
+where
 
-import           DBus
+import DBus
 
 xmonadBusName :: BusName
 xmonadBusName = busName_ "org.xmonad"
@@ -25,4 +26,3 @@ notifyPath = objectPath_ "/org/freedesktop/Notifications"
 
 networkManagerBus :: BusName
 networkManagerBus = busName_ "org.freedesktop.NetworkManager"
-
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 719a4c4..cc910e6 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -1,11 +1,11 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 --------------------------------------------------------------------------------
--- | High-level interface for managing XMonad's DBus
+-- High-level interface for managing XMonad's DBus
 
 module XMonad.Internal.DBus.Control
   ( Client
-  , DBusState(..)
+  , DBusState (..)
   , connectDBus
   , connectDBusX
   , disconnectDBus
@@ -15,33 +15,31 @@ module XMonad.Internal.DBus.Control
   , withDBusClient_
   , disconnect
   , dbusExporters
-  ) where
+  )
+where
 
-import           Control.Monad
-
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-
-import           DBus
-import           DBus.Client
-
-import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
-import           XMonad.Internal.DBus.Brightness.IntelBacklight
-import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.DBus.Screensaver
+import Control.Monad
+import DBus
+import DBus.Client
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import XMonad.Internal.DBus.Brightness.ClevoKeyboard
+import XMonad.Internal.DBus.Brightness.IntelBacklight
+import XMonad.Internal.DBus.Common
+import XMonad.Internal.DBus.Screensaver
 
 -- | Current connections to the DBus (session and system buses)
 data DBusState = DBusState
-    { dbSesClient :: Maybe SesClient
-    , dbSysClient :: Maybe SysClient
-    }
+  { dbSesClient :: Maybe SesClient
+  , dbSysClient :: Maybe SysClient
+  }
 
 -- | Connect to the DBus
 connectDBus :: IO DBusState
 connectDBus = do
   ses <- getDBusClient
   sys <- getDBusClient
-  return DBusState { dbSesClient = ses, dbSysClient = sys }
+  return DBusState {dbSesClient = ses, dbSysClient = sys}
 
 -- | Disconnect from the DBus
 disconnectDBus :: DBusState -> IO ()
@@ -73,11 +71,13 @@ requestXMonadName :: SesClient -> IO ()
 requestXMonadName ses = do
   res <- requestName (toClient ses) xmonadBusName []
   -- TODO if the client is not released on shutdown the owner will be different
-  let msg | res == NamePrimaryOwner = Nothing
-          | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
-          | res == NameInQueue
-            || res == NameExists = Just $ "another process owns " ++ xn
-          | otherwise = Just $ "unknown error when requesting " ++ xn
+  let msg
+        | res == NamePrimaryOwner = Nothing
+        | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
+        | res == NameInQueue
+            || res == NameExists =
+            Just $ "another process owns " ++ xn
+        | otherwise = Just $ "unknown error when requesting " ++ xn
   forM_ msg putStrLn
   where
     xn = "'" ++ formatBusName xmonadBusName ++ "'"
diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs
index e891314..87c0766 100644
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@@ -1,24 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Module for monitoring removable drive events
+-- Module for monitoring removable drive events
 --
 -- Currently, its only purpose is to play Super Mario sounds when a drive is
 -- inserted or removed. Why? Because I can.
 
 module XMonad.Internal.DBus.Removable (runRemovableMon) where
 
-import           Control.Monad
-
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-import           Data.Map.Strict                 (Map, member)
-
-import           DBus
-import           DBus.Client
-
-import           XMonad.Core                     (io)
-import           XMonad.Internal.Command.Desktop
+import Control.Monad
+import DBus
+import DBus.Client
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import Data.Map.Strict (Map, member)
+import XMonad.Core (io)
+import XMonad.Internal.Command.Desktop
 
 bus :: BusName
 bus = busName_ "org.freedesktop.UDisks2"
@@ -51,22 +48,29 @@ driveRemovedSound :: FilePath
 driveRemovedSound = "smb_pipe.wav"
 
 ruleUdisks :: MatchRule
-ruleUdisks = matchAny
-  { matchPath = Just path
-  , matchInterface = Just interface
-  }
+ruleUdisks =
+  matchAny
+    { matchPath = Just path
+    , matchInterface = Just interface
+    }
 
 driveFlag :: String
 driveFlag = "org.freedesktop.UDisks2.Drive"
 
 addedHasDrive :: [Variant] -> Bool
-addedHasDrive [_, a] = maybe False (member driveFlag)
-  (fromVariant a :: Maybe (Map String (Map String Variant)))
+addedHasDrive [_, a] =
+  maybe
+    False
+    (member driveFlag)
+    (fromVariant a :: Maybe (Map String (Map String Variant)))
 addedHasDrive _ = False
 
 removedHasDrive :: [Variant] -> Bool
-removedHasDrive [_, a] = maybe False (driveFlag `elem`)
-  (fromVariant a :: Maybe [String])
+removedHasDrive [_, a] =
+  maybe
+    False
+    (driveFlag `elem`)
+    (fromVariant a :: Maybe [String])
 removedHasDrive _ = False
 
 playSoundMaybe :: FilePath -> Bool -> IO ()
@@ -81,8 +85,10 @@ listenDevices cl = do
   addMatch' memAdded driveInsertedSound addedHasDrive
   addMatch' memRemoved driveRemovedSound removedHasDrive
   where
-    addMatch' m p f = void $ addMatch (toClient cl) ruleUdisks { matchMember = Just m }
-      $ playSoundMaybe p . f . signalBody
+    addMatch' m p f =
+      void $
+        addMatch (toClient cl) ruleUdisks {matchMember = Just m} $
+          playSoundMaybe p . f . signalBody
 
 runRemovableMon :: Maybe SysClient -> SometimesIO
 runRemovableMon cl =
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 81e8bab..a38a7f2 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | DBus module for X11 screensave/DPMS control
+-- DBus module for X11 screensave/DPMS control
 
 module XMonad.Internal.DBus.Screensaver
   ( exportScreensaver
@@ -9,25 +9,22 @@ module XMonad.Internal.DBus.Screensaver
   , callQuery
   , matchSignal
   , ssSignalDep
-  ) where
+  )
+where
 
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-
-import           RIO
-
-import           DBus
-import           DBus.Client
-import qualified DBus.Introspection          as I
-
-import           Graphics.X11.XScreenSaver
-import           Graphics.X11.Xlib.Display
-
-import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Shell
+import DBus
+import DBus.Client
+import qualified DBus.Introspection as I
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import Graphics.X11.XScreenSaver
+import Graphics.X11.Xlib.Display
+import RIO
+import XMonad.Internal.DBus.Common
+import XMonad.Internal.Shell
 
 --------------------------------------------------------------------------------
--- | Low-level functions
+-- Low-level functions
 
 type SSState = Bool -- true is enabled
 
@@ -50,13 +47,13 @@ query = do
   xssi <- xScreenSaverQueryInfo dpy
   closeDisplay dpy
   return $ case xssi of
-    Just XScreenSaverInfo { xssi_state = ScreenSaverDisabled } -> False
-    Just XScreenSaverInfo { xssi_state = _ }                   -> True
+    Just XScreenSaverInfo {xssi_state = ScreenSaverDisabled} -> False
+    Just XScreenSaverInfo {xssi_state = _} -> True
     -- TODO handle errors better (at least log them?)
-    Nothing                                                    -> False
+    Nothing -> False
 
 --------------------------------------------------------------------------------
--- | DBus Interface
+-- DBus Interface
 --
 -- Define a methods to toggle the screensaver. This methods will emit signal
 -- with the new state when called. Define another method to get the current
@@ -81,51 +78,64 @@ sigCurrentState :: Signal
 sigCurrentState = signal ssPath interface memState
 
 ruleCurrentState :: MatchRule
-ruleCurrentState = matchAny
-  { matchPath = Just ssPath
-  , matchInterface = Just interface
-  , matchMember = Just memState
-  }
+ruleCurrentState =
+  matchAny
+    { matchPath = Just ssPath
+    , matchInterface = Just interface
+    , matchMember = Just memState
+    }
 
 emitState :: Client -> SSState -> IO ()
-emitState client sss = emit client $ sigCurrentState { signalBody = [toVariant sss] }
+emitState client sss = emit client $ sigCurrentState {signalBody = [toVariant sss]}
 
 bodyGetCurrentState :: [Variant] -> Maybe SSState
 bodyGetCurrentState [b] = fromVariant b :: Maybe SSState
-bodyGetCurrentState _   = Nothing
+bodyGetCurrentState _ = Nothing
 
 --------------------------------------------------------------------------------
--- | Exported haskell API
+-- Exported haskell API
 
 exportScreensaver :: Maybe SesClient -> SometimesIO
 exportScreensaver ses =
   sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) cmd
   where
-    cmd cl = let cl' = toClient cl in
-      liftIO $ export cl' ssPath defaultInterface
-      { interfaceName = interface
-      , interfaceMethods =
-        [ autoMethod memToggle $ emitState cl' =<< toggle
-        , autoMethod memQuery query
-        ]
-      , interfaceSignals = [sig]
-      }
-    sig = I.Signal
-      { I.signalName = memState
-      , I.signalArgs =
-        [
-          I.SignalArg
-          { I.signalArgName = "enabled"
-          , I.signalArgType = TypeBoolean
-          }
-        ]
-      }
+    cmd cl =
+      let cl' = toClient cl
+       in liftIO $
+            export
+              cl'
+              ssPath
+              defaultInterface
+                { interfaceName = interface
+                , interfaceMethods =
+                    [ autoMethod memToggle $ emitState cl' =<< toggle
+                    , autoMethod memQuery query
+                    ]
+                , interfaceSignals = [sig]
+                }
+    sig =
+      I.Signal
+        { I.signalName = memState
+        , I.signalArgs =
+            [ I.SignalArg
+                { I.signalArgName = "enabled"
+                , I.signalArgType = TypeBoolean
+                }
+            ]
+        }
     bus = Bus [] xmonadBusName
     ssx = DBusIO $ sysExe [Package Official "xorg-xset"] ssExecutable
 
 callToggle :: Maybe SesClient -> SometimesX
-callToggle = sometimesEndpoint "screensaver toggle" "dbus switch" []
-  xmonadBusName ssPath interface memToggle
+callToggle =
+  sometimesEndpoint
+    "screensaver toggle"
+    "dbus switch"
+    []
+    xmonadBusName
+    ssPath
+    interface
+    memToggle
 
 callQuery :: SesClient -> IO (Maybe SSState)
 callQuery ses = do
@@ -133,8 +143,12 @@ callQuery ses = do
   return $ either (const Nothing) bodyGetCurrentState reply
 
 matchSignal :: (Maybe SSState -> IO ()) -> SesClient -> IO ()
-matchSignal cb ses = void $ addMatchCallback ruleCurrentState
-  (cb . bodyGetCurrentState) ses
+matchSignal cb ses =
+  void $
+    addMatchCallback
+      ruleCurrentState
+      (cb . bodyGetCurrentState)
+      ses
 
 ssSignalDep :: DBusDependency_ SesClient
 ssSignalDep = Endpoint [] xmonadBusName ssPath interface $ Signal_ memState
diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs
index 00e212f..ed6a8a9 100644
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE ViewPatterns #-}
 
 --------------------------------------------------------------------------------
--- | Random IO-ish functions used throughtout xmonad
+-- Random IO-ish functions used throughtout xmonad
 --
 -- Most (probably all) of these functions are intended to work with sysfs where
 -- some safe assumptions can be made about file contents.
@@ -19,32 +19,31 @@ module XMonad.Internal.IO
   , incPercent
   -- , isReadable
   -- , isWritable
-  , PermResult(..)
+  , PermResult (..)
   , getPermissionsSafe
   , waitUntilExit
-  ) where
+  )
+where
 
-import           Data.Char
-import           Data.Text       (pack, unpack)
-import           Data.Text.IO    as T (readFile, writeFile)
-
-import           RIO
-import           RIO.Directory
-import           RIO.FilePath
-
-import           System.IO.Error
+import Data.Char
+import Data.Text (pack, unpack)
+import Data.Text.IO as T (readFile, writeFile)
+import RIO
+import RIO.Directory
+import RIO.FilePath
+import System.IO.Error
 
 --------------------------------------------------------------------------------
--- | read
+-- read
 
 readInt :: (Read a, Integral a) => FilePath -> IO a
 readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile
 
 readBool :: FilePath -> IO Bool
-readBool = fmap (==(1 :: Int)) . readInt
+readBool = fmap (== (1 :: Int)) . readInt
 
 --------------------------------------------------------------------------------
--- | write
+-- write
 
 writeInt :: (Show a, Integral a) => FilePath -> a -> IO ()
 writeInt f = T.writeFile f . pack . show
@@ -53,16 +52,16 @@ writeBool :: FilePath -> Bool -> IO ()
 writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
 
 --------------------------------------------------------------------------------
--- | percent-based read/write
+-- percent-based read/write
 --
 -- "Raw" values are whatever is stored in sysfs and "percent" is the user-facing
 -- value. Assume that the file being read has a min of 0 and an unchanging max
 -- given by a runtime argument, which is scaled linearly to the range 0-100
 -- (percent).
-
 rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => (a, a) -> b -> c
 rawToPercent (lower, upper) raw =
   100 * (fromIntegral raw - fromIntegral lower) / fromIntegral (upper - lower)
+
 -- rawToPercent upper raw = 100 * fromIntegral raw / fromIntegral upper
 
 readPercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
@@ -71,12 +70,14 @@ readPercent bounds path = do
   return $ rawToPercent bounds (i :: Integer)
 
 percentToRaw :: (Integral a, RealFrac b, Integral c) => (a, a) -> b -> c
-percentToRaw (lower, upper) perc = round $
-  fromIntegral lower + perc / 100.0 * (fromIntegral upper - fromIntegral lower)
+percentToRaw (lower, upper) perc =
+  round $
+    fromIntegral lower + perc / 100.0 * (fromIntegral upper - fromIntegral lower)
 
 writePercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> b -> IO b
 writePercent bounds path perc = do
-  let t | perc > 100 = 100
+  let t
+        | perc > 100 = 100
         | perc < 0 = 0
         | otherwise = perc
   writeInt path (percentToRaw bounds t :: Int)
@@ -88,9 +89,15 @@ writePercentMin bounds path = writePercent bounds path 0
 writePercentMax :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
 writePercentMax bounds path = writePercent bounds path 100
 
-shiftPercent :: (Integral a, RealFrac b) => (b -> b -> b) -> Int -> FilePath
-  -> (a, a) -> IO b
-shiftPercent f steps path bounds = writePercent bounds path . f stepsize
+shiftPercent
+  :: (Integral a, RealFrac b)
+  => (b -> b -> b)
+  -> Int
+  -> FilePath
+  -> (a, a)
+  -> IO b
+shiftPercent f steps path bounds =
+  writePercent bounds path . f stepsize
     =<< readPercent bounds path
   where
     stepsize = 100 / fromIntegral steps
@@ -102,7 +109,7 @@ decPercent :: (Integral a, RealFrac b) => Int -> FilePath -> (a, a) -> IO b
 decPercent = shiftPercent subtract -- silly (-) operator thingy error
 
 --------------------------------------------------------------------------------
--- | permission query
+-- permission query
 
 data PermResult a = PermResult a | NotFoundError | PermError
   deriving (Show, Eq)
@@ -116,12 +123,12 @@ getPermissionsSafe :: FilePath -> IO (PermResult Permissions)
 getPermissionsSafe f = do
   r <- tryIOError $ getPermissions f
   return $ case r of
-    Right z                            -> PermResult z
-    Left (isPermissionError -> True)   -> PermError
+    Right z -> PermResult z
+    Left (isPermissionError -> True) -> PermError
     Left (isDoesNotExistError -> True) -> NotFoundError
     -- the above error should be the only ones thrown by getPermission,
     -- so the catchall case should never happen
-    _                                  -> error "Unknown permission error"
+    _ -> error "Unknown permission error"
 
 -- isReadable :: FilePath -> IO (PermResult Bool)
 -- isReadable = fmap (fmap readable) . getPermissionsSafe
diff --git a/lib/XMonad/Internal/Notify.hs b/lib/XMonad/Internal/Notify.hs
index f4063f2..cd2f540 100644
--- a/lib/XMonad/Internal/Notify.hs
+++ b/lib/XMonad/Internal/Notify.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Functions for formatting and sending notifications
+-- Functions for formatting and sending notifications
 --
 -- NOTE I use the DBus.Notify lib even though I don't actually use the DBus for
 -- notifications (just formation them into 'notify-send' commands and spawn a
@@ -9,42 +9,45 @@
 -- decide to switch to using the DBus it will be easy.
 
 module XMonad.Internal.Notify
-  ( Note(..)
-  , Body(..)
+  ( Note (..)
+  , Body (..)
   , defNote
   , defNoteInfo
   , defNoteError
   , fmtNotifyCmd
   , spawnNotify
-  ) where
+  )
+where
 
-import           DBus.Notify
-
-import           RIO
-import qualified RIO.Text              as T
-
-import           XMonad.Internal.Shell
+import DBus.Notify
+import RIO
+import qualified RIO.Text as T
+import XMonad.Internal.Shell
 
 --------------------------------------------------------------------------------
--- | Some nice default notes
+-- Some nice default notes
 
 defNote :: Note
-defNote = blankNote { summary = "\"xmonad\"" }
+defNote = blankNote {summary = "\"xmonad\""}
 
 defNoteInfo :: Note
-defNoteInfo = defNote
-  { appImage = Just $ Icon "dialog-information-symbolic" }
+defNoteInfo =
+  defNote
+    { appImage = Just $ Icon "dialog-information-symbolic"
+    }
 
 defNoteError :: Note
-defNoteError = defNote
-  { appImage = Just $ Icon "dialog-error-symbolic" }
+defNoteError =
+  defNote
+    { appImage = Just $ Icon "dialog-error-symbolic"
+    }
 
 --------------------------------------------------------------------------------
--- | Format a 'notify-send' command to be send to the shell
+-- Format a 'notify-send' command to be send to the shell
 
 parseBody :: Body -> Maybe T.Text
 parseBody (Text s) = Just $ T.pack s
-parseBody _        = Nothing
+parseBody _ = Nothing
 
 fmtNotifyCmd :: Note -> T.Text
 fmtNotifyCmd = fmtCmd "notify-send" . fmtNotifyArgs
@@ -56,8 +59,8 @@ fmtNotifyArgs :: Note -> [T.Text]
 fmtNotifyArgs n = getIcon n ++ getSummary n ++ getBody n
   where
     -- TODO add the rest of the options as needed
-    getSummary = (:[]) . doubleQuote . T.pack . summary
+    getSummary = (: []) . doubleQuote . T.pack . summary
     getIcon n' =
-      maybe [] (\i -> ["-i", T.pack $ case i of { Icon s -> s; File s -> s }])
-      $ appImage n'
+      maybe [] (\i -> ["-i", T.pack $ case i of Icon s -> s; File s -> s]) $
+        appImage n'
     getBody n' = maybeToList $ (fmap doubleQuote . parseBody) =<< body n'
diff --git a/lib/XMonad/Internal/Process.hs b/lib/XMonad/Internal/Process.hs
deleted file mode 100644
index 1e493d6..0000000
--- a/lib/XMonad/Internal/Process.hs
+++ /dev/null
@@ -1,17 +0,0 @@
---------------------------------------------------------------------------------
--- | Functions for managing processes
-
-module XMonad.Internal.Process where
-
--- import           Control.Exception
--- import           Control.Monad
--- import           Control.Monad.IO.Class
-
--- import qualified RIO.Text               as T
-
--- import           System.Exit
--- import           System.IO
--- import           System.Process
-
--- import           XMonad.Core            hiding (spawn)
-
diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index 00264ee..d44249f 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -1,7 +1,7 @@
--- | Functions for formatting and spawning shell commands
-
 {-# LANGUAGE OverloadedStrings #-}
 
+-- Functions for formatting and spawning shell commands
+
 module XMonad.Internal.Shell
   ( fmtCmd
   , spawnCmd
@@ -17,15 +17,14 @@ module XMonad.Internal.Shell
   , (#!||)
   , (#!|)
   , (#!>>)
-  ) where
-
-import           RIO
-import qualified RIO.Text             as T
+  )
+where
 
+import RIO
+import qualified RIO.Text as T
 import qualified System.Process.Typed as P
-
-import qualified XMonad.Core          as X
-import qualified XMonad.Util.Run      as XR
+import qualified XMonad.Core as X
+import qualified XMonad.Util.Run as XR
 
 -- | Fork a new process and wait for its exit code.
 --
diff --git a/lib/XMonad/Internal/Theme.hs b/lib/XMonad/Internal/Theme.hs
index 165b75a..4e38c47 100644
--- a/lib/XMonad/Internal/Theme.hs
+++ b/lib/XMonad/Internal/Theme.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Theme for XMonad and Xmobar
+-- Theme for XMonad and Xmobar
 
 module XMonad.Internal.Theme
   ( baseColor
@@ -18,9 +18,9 @@ module XMonad.Internal.Theme
   , backdropTextColor
   , blend'
   , darken'
-  , Slant(..)
-  , Weight(..)
-  , FontData(..)
+  , Slant (..)
+  , Weight (..)
+  , FontData (..)
   , FontBuilder
   , buildFont
   , fallbackFont
@@ -28,18 +28,17 @@ module XMonad.Internal.Theme
   , defFontData
   , tabbedTheme
   , promptTheme
-  ) where
-
-import           Data.Colour
-import           Data.Colour.SRGB
-
-import qualified RIO.Text                 as T
+  )
+where
 
+import Data.Colour
+import Data.Colour.SRGB
+import qualified RIO.Text as T
 import qualified XMonad.Layout.Decoration as D
-import qualified XMonad.Prompt            as P
+import qualified XMonad.Prompt as P
 
 --------------------------------------------------------------------------------
--- | Colors - vocabulary roughly based on GTK themes
+-- Colors - vocabulary roughly based on GTK themes
 
 baseColor :: T.Text
 baseColor = "#f7f7f7"
@@ -78,7 +77,7 @@ backdropFgColor :: T.Text
 backdropFgColor = blend' 0.75 fgColor bgColor
 
 --------------------------------------------------------------------------------
--- | Color functions
+-- Color functions
 
 blend' :: Float -> T.Text -> T.Text -> T.Text
 blend' wt c0 c1 = sRGB24showT $ blend wt (sRGB24readT c0) (sRGB24readT c1)
@@ -93,64 +92,73 @@ sRGB24showT :: (RealFrac a, Floating a) => Colour a -> T.Text
 sRGB24showT = T.pack . sRGB24show
 
 --------------------------------------------------------------------------------
--- | Fonts
+-- Fonts
 
-data Slant = Roman
-    | Italic
-    | Oblique
-    deriving (Eq, Show)
+data Slant
+  = Roman
+  | Italic
+  | Oblique
+  deriving (Eq, Show)
 
-data Weight = Light
-    | Medium
-    | Demibold
-    | Bold
-    | Black
-    deriving (Eq, Show)
+data Weight
+  = Light
+  | Medium
+  | Demibold
+  | Bold
+  | Black
+  deriving (Eq, Show)
 
 data FontData = FontData
-    { weight    :: Maybe Weight
-    , slant     :: Maybe Slant
-    , size      :: Maybe Int
-    , pixelsize :: Maybe Int
-    , antialias :: Maybe Bool
-    }
+  { weight :: Maybe Weight
+  , slant :: Maybe Slant
+  , size :: Maybe Int
+  , pixelsize :: Maybe Int
+  , antialias :: Maybe Bool
+  }
 
 type FontBuilder = FontData -> T.Text
 
 buildFont :: Maybe T.Text -> FontData -> T.Text
 buildFont Nothing _ = "fixed"
-buildFont (Just fam) FontData { weight = w
-                            , slant = l
-                            , size = s
-                            , pixelsize = p
-                            , antialias = a
-                            }
-  = T.intercalate ":" $ ["xft", fam] ++ elems
-  where
-    elems = [ T.concat [k, "=", v] | (k, Just v) <- [ ("weight", showLower w)
-                                                    , ("slant", showLower l)
-                                                    , ("size", showLower s)
-                                                    , ("pixelsize", showLower p)
-                                                    , ("antialias", showLower a)
-                                                    ]
-                            ]
-    showLower :: Show a => Maybe a -> Maybe T.Text
-    showLower = fmap (T.toLower . T.pack . show)
+buildFont
+  (Just fam)
+  FontData
+    { weight = w
+    , slant = l
+    , size = s
+    , pixelsize = p
+    , antialias = a
+    } =
+    T.intercalate ":" $ ["xft", fam] ++ elems
+    where
+      elems =
+        [ T.concat [k, "=", v]
+        | (k, Just v) <-
+            [ ("weight", showLower w)
+            , ("slant", showLower l)
+            , ("size", showLower s)
+            , ("pixelsize", showLower p)
+            , ("antialias", showLower a)
+            ]
+        ]
+      showLower :: Show a => Maybe a -> Maybe T.Text
+      showLower = fmap (T.toLower . T.pack . show)
 
 fallbackFont :: FontBuilder
 fallbackFont = buildFont Nothing
 
 --------------------------------------------------------------------------------
--- | Default font and data
+-- Default font and data
 
 defFontData :: FontData
-defFontData = FontData
-  { size = Just 10
-  , antialias = Just True
-  , weight = Nothing
-  , slant = Nothing
-  , pixelsize = Nothing
-  }
+defFontData =
+  FontData
+    { size = Just 10
+    , antialias = Just True
+    , weight = Nothing
+    , slant = Nothing
+    , pixelsize = Nothing
+    }
 
 defFontFamily :: T.Text
 defFontFamily = "DejaVu Sans"
@@ -162,44 +170,42 @@ defFontFamily = "DejaVu Sans"
 -- defFontTree = fontTree "DejaVu Sans"
 
 --------------------------------------------------------------------------------
--- | Complete themes
+-- Complete themes
 
 tabbedTheme :: FontBuilder -> D.Theme
-tabbedTheme fb = D.def
-  { D.fontName              = T.unpack $ fb $ defFontData { weight = Just Bold }
+tabbedTheme fb =
+  D.def
+    { D.fontName = T.unpack $ fb $ defFontData {weight = Just Bold}
+    , D.activeTextColor = T.unpack fgColor
+    , D.activeColor = T.unpack bgColor
+    , D.activeBorderColor = T.unpack bgColor
+    , D.inactiveTextColor = T.unpack backdropTextColor
+    , D.inactiveColor = T.unpack backdropFgColor
+    , D.inactiveBorderColor = T.unpack backdropFgColor
+    , D.urgentTextColor = T.unpack $ darken' 0.5 errorColor
+    , D.urgentColor = T.unpack errorColor
+    , D.urgentBorderColor = T.unpack errorColor
+    , -- this is in a newer version
+      -- , D.activeBorderWidth     = 0
+      -- , D.inactiveBorderWidth   = 0
+      -- , D.urgentBorderWidth     = 0
 
-  , D.activeTextColor       = T.unpack fgColor
-  , D.activeColor           = T.unpack bgColor
-  , D.activeBorderColor     = T.unpack bgColor
-
-  , D.inactiveTextColor     = T.unpack backdropTextColor
-  , D.inactiveColor         = T.unpack backdropFgColor
-  , D.inactiveBorderColor   = T.unpack backdropFgColor
-
-  , D.urgentTextColor       = T.unpack $ darken' 0.5 errorColor
-  , D.urgentColor           = T.unpack errorColor
-  , D.urgentBorderColor     = T.unpack errorColor
-
-  -- this is in a newer version
-  -- , D.activeBorderWidth     = 0
-  -- , D.inactiveBorderWidth   = 0
-  -- , D.urgentBorderWidth     = 0
-
-  , D.decoHeight            = 20
-  , D.windowTitleAddons     = []
-  , D.windowTitleIcons      = []
-  }
+      D.decoHeight = 20
+    , D.windowTitleAddons = []
+    , D.windowTitleIcons = []
+    }
 
 promptTheme :: FontBuilder -> P.XPConfig
-promptTheme fb = P.def
-  { P.font              = T.unpack $ fb $ defFontData { size = Just 12 }
-  , P.bgColor           = T.unpack bgColor
-  , P.fgColor           = T.unpack fgColor
-  , P.fgHLight          = T.unpack selectedFgColor
-  , P.bgHLight          = T.unpack selectedBgColor
-  , P.borderColor       = T.unpack bordersColor
-  , P.promptBorderWidth = 1
-  , P.height            = 35
-  , P.position          = P.CenteredAt 0.5 0.5
-  , P.historySize       = 0
-  }
+promptTheme fb =
+  P.def
+    { P.font = T.unpack $ fb $ defFontData {size = Just 12}
+    , P.bgColor = T.unpack bgColor
+    , P.fgColor = T.unpack fgColor
+    , P.fgHLight = T.unpack selectedFgColor
+    , P.bgHLight = T.unpack selectedBgColor
+    , P.borderColor = T.unpack bordersColor
+    , P.promptBorderWidth = 1
+    , P.height = 35
+    , P.position = P.CenteredAt 0.5 0.5
+    , P.historySize = 0
+    }
diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs
index b8f9f7f..f496fe3 100644
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@@ -1,25 +1,26 @@
 {-# LANGUAGE OverloadedStrings #-}
 
---------------------------------------------------------------------------------
--- | Common backlight plugin bits
+-- 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           Data.Internal.DBus
+import Data.Internal.DBus
+import qualified RIO.Text as T
+import Xmobar.Plugins.Common
 
-import qualified RIO.Text              as T
-
-import           Xmobar.Plugins.Common
-
-startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ())
-  -> (SesClient -> IO (Maybe a)) -> T.Text -> Callback -> IO ()
+startBacklight
+  :: RealFrac a
+  => ((Maybe a -> IO ()) -> SesClient -> IO ())
+  -> (SesClient -> IO (Maybe a))
+  -> T.Text
+  -> Callback
+  -> IO ()
 startBacklight matchSignal callGetBrightness icon cb = do
-    withDBusClientConnection cb $ \c -> do
-      matchSignal display c
-      display =<< callGetBrightness c
-    where
-      formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"]
-      display = displayMaybe cb formatBrightness
+  withDBusClientConnection cb $ \c -> do
+    matchSignal display c
+    display =<< callGetBrightness c
+  where
+    formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"]
+    display = displayMaybe cb formatBrightness
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 9a9dbd9..0ae39e0 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Bluetooth plugin
+-- Bluetooth plugin
 --
 -- Use the bluez interface on DBus to check status
 --
@@ -33,36 +33,34 @@
 -- adapter changing.
 
 module Xmobar.Plugins.Bluetooth
-  ( Bluetooth(..)
+  ( Bluetooth (..)
   , btAlias
   , btDep
-  ) where
+  )
+where
 
-import           Control.Concurrent.MVar
-import           Control.Monad
-
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-import           Data.List
-import           Data.List.Split
-import qualified Data.Map                    as M
-import           Data.Maybe
-
-import           DBus
-import           DBus.Client
-
-import qualified RIO.Text                    as T
-
-import           XMonad.Internal.DBus.Common
-import           Xmobar
-import           Xmobar.Plugins.Common
+import Control.Concurrent.MVar
+import Control.Monad
+import DBus
+import DBus.Client
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import Data.List
+import Data.List.Split
+import qualified Data.Map as M
+import Data.Maybe
+import qualified RIO.Text as T
+import XMonad.Internal.DBus.Common
+import Xmobar
+import Xmobar.Plugins.Common
 
 btAlias :: T.Text
 btAlias = "bluetooth"
 
 btDep :: DBusDependency_ SysClient
-btDep = Endpoint [Package Official "bluez"] btBus btOMPath omInterface
-  $ Method_ getManagedObjects
+btDep =
+  Endpoint [Package Official "bluez"] btBus btOMPath omInterface $
+    Method_ getManagedObjects
 
 data Bluetooth = Bluetooth Icons Colors deriving (Read, Show)
 
@@ -90,7 +88,7 @@ startAdapter is cs cb cl = do
     display
 
 --------------------------------------------------------------------------------
--- | Icon Display
+-- Icon Display
 --
 -- Color corresponds to the adaptor powered state, and the icon corresponds to
 -- if it is paired or not. If the adaptor state is undefined, display "N/A"
@@ -111,7 +109,7 @@ iconFormatter (iconConn, iconDisc) cs powered connected =
     icon = if connected then iconConn else iconDisc
 
 --------------------------------------------------------------------------------
--- | Connection State
+-- Connection State
 --
 -- The signal handlers all run on separate threads, yet the icon depends on
 -- the state reflected by all these signals. The best (only?) way to do this is
@@ -119,7 +117,7 @@ iconFormatter (iconConn, iconDisc) cs powered connected =
 -- an MVar.
 
 data BTDevice = BTDevice
-  { btDevConnected  :: Maybe Bool
+  { btDevConnected :: Maybe Bool
   , btDevSigHandler :: SignalHandler
   }
 
@@ -133,10 +131,11 @@ data BtState = BtState
 type MutableBtState = MVar BtState
 
 emptyState :: BtState
-emptyState = BtState
-  { btDevices = M.empty
-  , btPowered = Nothing
-  }
+emptyState =
+  BtState
+    { btDevices = M.empty
+    , btPowered = Nothing
+    }
 
 readState :: MutableBtState -> IO (Maybe Bool, Bool)
 readState state = do
@@ -145,7 +144,7 @@ readState state = do
   return (p, anyDevicesConnected c)
 
 --------------------------------------------------------------------------------
--- | Object manager
+-- Object manager
 
 findAdapter :: ObjectTree -> Maybe ObjectPath
 findAdapter = find (("/org/bluez/hci" `isPrefixOf`) . formatObjectPath) . M.keys
@@ -156,10 +155,10 @@ findDevices adapter = filter (adaptorHasDevice adapter) . M.keys
 adaptorHasDevice :: ObjectPath -> ObjectPath -> Bool
 adaptorHasDevice adaptor device = case splitPath device of
   [org, bluez, hciX, _] -> splitPath adaptor == [org, bluez, hciX]
-  _                     -> False
+  _ -> False
 
 splitPath :: ObjectPath -> [T.Text]
-splitPath = fmap T.pack . splitOn "/" . dropWhile (=='/') . formatObjectPath
+splitPath = fmap T.pack . splitOn "/" . dropWhile (== '/') . formatObjectPath
 
 getBtObjectTree :: SysClient -> IO ObjectTree
 getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
@@ -191,7 +190,7 @@ pathCallback adapter display f [device, _] = forM_ (fromVariant device) $ \d ->
 pathCallback _ _ _ _ = return ()
 
 --------------------------------------------------------------------------------
--- | Adapter
+-- Adapter
 
 initAdapter :: MutableBtState -> ObjectPath -> SysClient -> IO ()
 initAdapter state adapter client = do
@@ -201,7 +200,11 @@ initAdapter state adapter client = do
 matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule)
 matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
 
-addAdaptorListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
+addAdaptorListener
+  :: MutableBtState
+  -> IO ()
+  -> ObjectPath
+  -> SysClient
   -> IO (Maybe SignalHandler)
 addAdaptorListener state display adaptor sys = do
   rule <- matchBTProperty sys adaptor
@@ -210,14 +213,16 @@ addAdaptorListener state display adaptor sys = do
     procMatch = withSignalMatch $ \b -> putPowered state b >> display
 
 callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
-callGetPowered adapter = callPropertyGet btBus adapter adapterInterface
-  $ memberName_ $ T.unpack adaptorPowered
+callGetPowered adapter =
+  callPropertyGet btBus adapter adapterInterface $
+    memberName_ $
+      T.unpack adaptorPowered
 
 matchPowered :: [Variant] -> SignalMatch Bool
 matchPowered = matchPropertyChanged adapterInterface adaptorPowered
 
 putPowered :: MutableBtState -> Maybe Bool -> IO ()
-putPowered m ds = modifyMVar_ m (\s -> return s { btPowered = ds })
+putPowered m ds = modifyMVar_ m (\s -> return s {btPowered = ds})
 
 readPowered :: MutableBtState -> IO (Maybe Bool)
 readPowered = fmap btPowered . readMVar
@@ -229,7 +234,7 @@ adaptorPowered :: T.Text
 adaptorPowered = "Powered"
 
 --------------------------------------------------------------------------------
--- | Devices
+-- Devices
 
 addAndInitDevice :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
 addAndInitDevice state display device client = do
@@ -240,12 +245,18 @@ addAndInitDevice state display device client = do
 initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO ()
 initDevice state sh device sys = do
   reply <- callGetConnected device sys
-  void $ insertDevice state device $
-    BTDevice { btDevConnected = fromVariant =<< listToMaybe reply
-             , btDevSigHandler = sh
-             }
+  void $
+    insertDevice state device $
+      BTDevice
+        { btDevConnected = fromVariant =<< listToMaybe reply
+        , btDevSigHandler = sh
+        }
 
-addDeviceListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
+addDeviceListener
+  :: MutableBtState
+  -> IO ()
+  -> ObjectPath
+  -> SysClient
   -> IO (Maybe SignalHandler)
 addDeviceListener state display device sys = do
   rule <- matchBTProperty sys device
@@ -257,18 +268,19 @@ matchConnected :: [Variant] -> SignalMatch Bool
 matchConnected = matchPropertyChanged devInterface devConnected
 
 callGetConnected :: ObjectPath -> SysClient -> IO [Variant]
-callGetConnected p = callPropertyGet btBus p devInterface
-  $ memberName_ (T.unpack devConnected)
+callGetConnected p =
+  callPropertyGet btBus p devInterface $
+    memberName_ (T.unpack devConnected)
 
 insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool
 insertDevice m device dev = modifyMVar m $ \s -> do
   let new = M.insert device dev $ btDevices s
-  return (s { btDevices = new }, anyDevicesConnected new)
+  return (s {btDevices = new}, anyDevicesConnected new)
 
 updateDevice :: MutableBtState -> ObjectPath -> Maybe Bool -> IO Bool
 updateDevice m device status = modifyMVar m $ \s -> do
-  let new = M.update (\d -> Just d { btDevConnected = status }) device $ btDevices s
-  return (s { btDevices = new }, anyDevicesConnected new)
+  let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s
+  return (s {btDevices = new}, anyDevicesConnected new)
 
 anyDevicesConnected :: ConnectedDevices -> Bool
 anyDevicesConnected = or . mapMaybe btDevConnected . M.elems
@@ -276,7 +288,7 @@ anyDevicesConnected = or . mapMaybe btDevConnected . M.elems
 removeDevice :: MutableBtState -> ObjectPath -> IO (Maybe BTDevice)
 removeDevice m device = modifyMVar m $ \s -> do
   let devs = btDevices s
-  return (s { btDevices = M.delete device devs }, M.lookup device devs)
+  return (s {btDevices = M.delete device devs}, M.lookup device devs)
 
 readDevices :: MutableBtState -> IO ConnectedDevices
 readDevices = fmap btDevices . readMVar
diff --git a/lib/Xmobar/Plugins/ClevoKeyboard.hs b/lib/Xmobar/Plugins/ClevoKeyboard.hs
index 92a8f12..3f98f34 100644
--- a/lib/Xmobar/Plugins/ClevoKeyboard.hs
+++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs
@@ -1,23 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Clevo Keyboard plugin
+-- Clevo Keyboard plugin
 --
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 
 module Xmobar.Plugins.ClevoKeyboard
-  ( ClevoKeyboard(..)
+  ( ClevoKeyboard (..)
   , ckAlias
-  ) where
+  )
+where
 
-import qualified RIO.Text                                      as T
-
-import           Xmobar
-
-import           Xmobar.Plugins.BacklightCommon
-
-import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
+import qualified RIO.Text as T
+import XMonad.Internal.DBus.Brightness.ClevoKeyboard
+import Xmobar
+import Xmobar.Plugins.BacklightCommon
 
 newtype ClevoKeyboard = ClevoKeyboard T.Text deriving (Read, Show)
 
@@ -27,4 +25,4 @@ ckAlias = "clevokeyboard"
 instance Exec ClevoKeyboard where
   alias (ClevoKeyboard _) = T.unpack ckAlias
   start (ClevoKeyboard icon) =
-     startBacklight matchSignalCK callGetBrightnessCK icon
+    startBacklight matchSignalCK callGetBrightnessCK icon
diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs
index d28ee2b..f6bde99 100644
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@@ -8,36 +8,38 @@ module Xmobar.Plugins.Common
   , fromSingletonVariant
   , withDBusClientConnection
   , Callback
-  , Colors(..)
+  , Colors (..)
   , displayMaybe
   , displayMaybe'
   , xmobarFGColor
   )
-  where
+where
 
-import           Control.Monad
-
-import           Data.Internal.DBus
-
-import           DBus
-import           DBus.Client
-
-import qualified RIO.Text                as T
-
-import           XMonad.Hooks.DynamicLog (xmobarColor)
+import Control.Monad
+import DBus
+import DBus.Client
+import Data.Internal.DBus
+import qualified RIO.Text as T
+import XMonad.Hooks.DynamicLog (xmobarColor)
 
 -- use string here since all the callbacks in xmobar use strings :(
 type Callback = String -> IO ()
 
 data Colors = Colors
-  { colorsOn  :: T.Text
+  { colorsOn :: T.Text
   , colorsOff :: T.Text
   }
   deriving (Eq, Show, Read)
 
-startListener :: (SafeClient c, IsVariant a) => MatchRule -> (c -> IO [Variant])
-  -> ([Variant] -> SignalMatch a) -> (a -> IO T.Text) -> Callback
-  -> c -> IO ()
+startListener
+  :: (SafeClient c, IsVariant a)
+  => MatchRule
+  -> (c -> IO [Variant])
+  -> ([Variant] -> SignalMatch a)
+  -> (a -> IO T.Text)
+  -> Callback
+  -> c
+  -> IO ()
 startListener rule getProp fromSignal toColor cb client = do
   reply <- getProp client
   displayMaybe cb toColor $ fromSingletonVariant reply
@@ -49,8 +51,8 @@ procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO ()
 procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
 
 colorText :: Colors -> Bool -> T.Text -> T.Text
-colorText Colors { colorsOn = c } True   = xmobarFGColor c
-colorText Colors { colorsOff = c } False = xmobarFGColor c
+colorText Colors {colorsOn = c} True = xmobarFGColor c
+colorText Colors {colorsOff = c} False = xmobarFGColor c
 
 xmobarFGColor :: T.Text -> T.Text -> T.Text
 xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack
diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index 13abdb0..42e992b 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -1,30 +1,27 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Device plugin
+-- Device plugin
 --
 -- Display different text depending on whether or not the interface has
 -- connectivity
 
 module Xmobar.Plugins.Device
-  ( Device(..)
+  ( Device (..)
   , devDep
-  ) where
+  )
+where
 
-import           Control.Monad
-
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-import           Data.Word
-
-import           DBus
-
-import qualified RIO.Text                        as T
-
-import           XMonad.Internal.Command.Desktop
-import           XMonad.Internal.DBus.Common
-import           Xmobar
-import           Xmobar.Plugins.Common
+import Control.Monad
+import DBus
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import Data.Word
+import qualified RIO.Text as T
+import XMonad.Internal.Command.Desktop
+import XMonad.Internal.DBus.Common
+import Xmobar
+import Xmobar.Plugins.Common
 
 newtype Device = Device (T.Text, T.Text, Colors) deriving (Read, Show)
 
@@ -44,19 +41,23 @@ devSignal :: T.Text
 devSignal = "Ip4Connectivity"
 
 devDep :: DBusDependency_ SysClient
-devDep = Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface
-  $ Method_ getByIP
+devDep =
+  Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
+    Method_ getByIP
 
 getDevice :: SysClient -> T.Text -> IO (Maybe ObjectPath)
 getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
   where
-    mc = (methodCallBus networkManagerBus nmPath nmInterface getByIP)
-      { methodCallBody = [toVariant iface]
-      }
+    mc =
+      (methodCallBus networkManagerBus nmPath nmInterface getByIP)
+        { methodCallBody = [toVariant iface]
+        }
 
 getDeviceConnected :: ObjectPath -> SysClient -> IO [Variant]
-getDeviceConnected path = callPropertyGet networkManagerBus path nmDeviceInterface
-  $ memberName_ $ T.unpack devSignal
+getDeviceConnected path =
+  callPropertyGet networkManagerBus path nmDeviceInterface $
+    memberName_ $
+      T.unpack devSignal
 
 matchStatus :: [Variant] -> SignalMatch Word32
 matchStatus = matchPropertyChanged nmDeviceInterface devSignal
diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs
index e60a0fd..a4a777a 100644
--- a/lib/Xmobar/Plugins/IntelBacklight.hs
+++ b/lib/Xmobar/Plugins/IntelBacklight.hs
@@ -1,23 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Intel backlight plugin
+-- Intel backlight plugin
 --
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 
 module Xmobar.Plugins.IntelBacklight
-  ( IntelBacklight(..)
+  ( IntelBacklight (..)
   , blAlias
-  ) where
+  )
+where
 
-import qualified RIO.Text                                       as T
-
-import           Xmobar
-
-import           Xmobar.Plugins.BacklightCommon
-
-import           XMonad.Internal.DBus.Brightness.IntelBacklight
+import qualified RIO.Text as T
+import XMonad.Internal.DBus.Brightness.IntelBacklight
+import Xmobar
+import Xmobar.Plugins.BacklightCommon
 
 newtype IntelBacklight = IntelBacklight T.Text deriving (Read, Show)
 
@@ -27,4 +25,4 @@ blAlias = "intelbacklight"
 instance Exec IntelBacklight where
   alias (IntelBacklight _) = T.unpack blAlias
   start (IntelBacklight icon) =
-     startBacklight matchSignalIB callGetBrightnessIB icon
+    startBacklight matchSignalIB callGetBrightnessIB icon
diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs
index ef125cb..70fa3c1 100644
--- a/lib/Xmobar/Plugins/Screensaver.hs
+++ b/lib/Xmobar/Plugins/Screensaver.hs
@@ -1,22 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | Screensaver plugin
+-- Screensaver plugin
 --
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 
 module Xmobar.Plugins.Screensaver
-  ( Screensaver(..)
+  ( Screensaver (..)
   , ssAlias
-  ) where
+  )
+where
 
-import qualified RIO.Text                         as T
-
-import           Xmobar
-
-import           XMonad.Internal.DBus.Screensaver
-import           Xmobar.Plugins.Common
+import qualified RIO.Text as T
+import XMonad.Internal.DBus.Screensaver
+import Xmobar
+import Xmobar.Plugins.Common
 
 newtype Screensaver = Screensaver (T.Text, Colors) deriving (Read, Show)
 
@@ -31,4 +30,3 @@ instance Exec Screensaver where
       display =<< callQuery sys
     where
       display = displayMaybe cb $ return . (\s -> colorText colors s text)
-
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index 625abf8..a742134 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -1,35 +1,32 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
--- | VPN plugin
+-- VPN plugin
 --
 -- Use the networkmanager to detect when a VPN interface is added or removed.
 -- Specifically, monitor the object tree to detect paths with the interface
 -- "org.freedesktop.NetworkManager.Device.Tun".
 
 module Xmobar.Plugins.VPN
-  ( VPN(..)
+  ( VPN (..)
   , vpnAlias
   , vpnDep
-  ) where
+  )
+where
 
-import           Control.Concurrent.MVar
-import           Control.Monad
-
-import           Data.Internal.DBus
-import           Data.Internal.Dependency
-import qualified Data.Map                        as M
-import           Data.Maybe
-import qualified Data.Set                        as S
-
-import           DBus
-
-import qualified RIO.Text                        as T
-
-import           XMonad.Internal.Command.Desktop
-import           XMonad.Internal.DBus.Common
-import           Xmobar
-import           Xmobar.Plugins.Common
+import Control.Concurrent.MVar
+import Control.Monad
+import DBus
+import Data.Internal.DBus
+import Data.Internal.Dependency
+import qualified Data.Map as M
+import Data.Maybe
+import qualified Data.Set as S
+import qualified RIO.Text as T
+import XMonad.Internal.Command.Desktop
+import XMonad.Internal.DBus.Common
+import Xmobar
+import Xmobar.Plugins.Common
 
 newtype VPN = VPN (T.Text, Colors) deriving (Read, Show)
 
@@ -37,17 +34,17 @@ instance Exec VPN where
   alias (VPN _) = T.unpack vpnAlias
   start (VPN (text, colors)) cb =
     withDBusClientConnection cb $ \c -> do
-    state <- initState c
-    let display = displayMaybe cb iconFormatter . Just =<< readState state
-    let signalCallback' f = f state display
-    vpnAddedListener (signalCallback' addedCallback) c
-    vpnRemovedListener (signalCallback' removedCallback) c
-    display
+      state <- initState c
+      let display = displayMaybe cb iconFormatter . Just =<< readState state
+      let signalCallback' f = f state display
+      vpnAddedListener (signalCallback' addedCallback) c
+      vpnRemovedListener (signalCallback' removedCallback) c
+      display
     where
       iconFormatter b = return $ colorText colors b text
 
 --------------------------------------------------------------------------------
--- | VPN State
+-- VPN State
 --
 -- Maintain a set of paths which are the currently active VPNs. Most of the time
 -- this will be a null or singleton set, but this setup could handle the edge
@@ -65,13 +62,15 @@ initState client = do
 readState :: MutableVPNState -> IO Bool
 readState = fmap (not . null) . readMVar
 
-updateState :: (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
-  -> ObjectPath -> IO ()
+updateState
+  :: (ObjectPath -> VPNState -> VPNState)
+  -> MutableVPNState
+  -> ObjectPath
+  -> IO ()
 updateState f state op = modifyMVar_ state $ return . f op
 
 --------------------------------------------------------------------------------
--- | Tunnel Device Detection
---
+-- Tunnel Device Detection
 
 getVPNObjectTree :: SysClient -> IO ObjectTree
 getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
@@ -91,25 +90,30 @@ addedCallback state display [device, added] = update >> display
     added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant))
     is = M.keys $ fromMaybe M.empty added'
     update = updateDevice S.insert state device is
-addedCallback _ _ _                       = return ()
+addedCallback _ _ _ = return ()
 
 removedCallback :: MutableVPNState -> IO () -> SignalCallback
 removedCallback state display [device, interfaces] = update >> display
   where
     is = fromMaybe [] $ fromVariant interfaces :: [T.Text]
     update = updateDevice S.delete state device is
-removedCallback _ _ _                       = return ()
+removedCallback _ _ _ = return ()
 
-updateDevice :: (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
-  -> Variant -> [T.Text] -> IO ()
-updateDevice f state device interfaces = when (vpnDeviceTun `elem` interfaces) $
-  forM_ d $ updateState f state
+updateDevice
+  :: (ObjectPath -> VPNState -> VPNState)
+  -> MutableVPNState
+  -> Variant
+  -> [T.Text]
+  -> IO ()
+updateDevice f state device interfaces =
+  when (vpnDeviceTun `elem` interfaces) $
+    forM_ d $
+      updateState f state
   where
     d = fromVariant device :: Maybe ObjectPath
 
 --------------------------------------------------------------------------------
--- | DBus Interface
---
+-- DBus Interface
 
 vpnBus :: BusName
 vpnBus = busName_ "org.freedesktop.NetworkManager"
@@ -124,5 +128,6 @@ vpnAlias :: T.Text
 vpnAlias = "vpn"
 
 vpnDep :: DBusDependency_ SysClient
-vpnDep = Endpoint networkManagerPkgs networkManagerBus vpnPath omInterface
-  $ Method_ getManagedObjects
+vpnDep =
+  Endpoint networkManagerPkgs networkManagerBus vpnPath omInterface $
+    Method_ getManagedObjects
diff --git a/package.yaml b/package.yaml
index 3885185..e299e06 100644
--- a/package.yaml
+++ b/package.yaml
@@ -7,7 +7,7 @@ copyright:           "2022 Nathan Dwarshuis"
 
 extra-source-files:
 - README.md
-- .stylish-haskell.yaml
+- fourmolu.yaml
 - make_pkgs
 - icons/*
 - scripts/*

From 993b9e731af827b6c0e6483f2a2b5f47b284f654 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 16:29:50 -0500
Subject: [PATCH 029/118] ENH generalize io monads in dbus

---
 lib/Data/Internal/DBus.hs | 76 ++++++++++++++++++++-------------------
 1 file changed, 39 insertions(+), 37 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 7015065..51b2698 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -28,13 +28,13 @@ module Data.Internal.DBus
   )
 where
 
-import Control.Exception
 import Control.Monad
 import DBus
 import DBus.Client
 import Data.Bifunctor
 import qualified Data.Map.Strict as M
 import Data.Maybe
+import RIO
 import qualified RIO.Text as T
 
 --------------------------------------------------------------------------------
@@ -43,23 +43,23 @@ import qualified RIO.Text as T
 class SafeClient c where
   toClient :: c -> Client
 
-  getDBusClient :: IO (Maybe c)
+  getDBusClient :: MonadUnliftIO m => m (Maybe c)
 
-  disconnectDBusClient :: c -> IO ()
-  disconnectDBusClient = disconnect . toClient
+  disconnectDBusClient :: MonadUnliftIO m => c -> m ()
+  disconnectDBusClient = liftIO . disconnect . toClient
 
-  withDBusClient :: (c -> IO a) -> IO (Maybe a)
+  withDBusClient :: MonadUnliftIO m => (c -> m a) -> m (Maybe a)
   withDBusClient f = do
     client <- getDBusClient
     forM client $ \c -> do
       r <- f c
-      disconnect (toClient c)
+      liftIO $ disconnect (toClient c)
       return r
 
-  withDBusClient_ :: (c -> IO ()) -> IO ()
+  withDBusClient_ :: MonadUnliftIO m => (c -> m ()) -> m ()
   withDBusClient_ = void . withDBusClient
 
-  fromDBusClient :: (c -> a) -> IO (Maybe a)
+  fromDBusClient :: MonadUnliftIO m => (c -> a) -> m (Maybe a)
   fromDBusClient f = withDBusClient (return . f)
 
 newtype SysClient = SysClient Client
@@ -76,11 +76,11 @@ instance SafeClient SesClient where
 
   getDBusClient = fmap SesClient <$> getDBusClient' False
 
-getDBusClient' :: Bool -> IO (Maybe Client)
+getDBusClient' :: MonadUnliftIO m => Bool -> m (Maybe Client)
 getDBusClient' sys = do
-  res <- try $ if sys then connectSystem else connectSession
+  res <- try $ liftIO $ if sys then connectSystem else connectSession
   case res of
-    Left e -> putStrLn (clientErrorMessage e) >> return Nothing
+    Left e -> liftIO $ putStrLn (clientErrorMessage e) >> return Nothing
     Right c -> return $ Just c
 
 --------------------------------------------------------------------------------
@@ -88,19 +88,20 @@ getDBusClient' sys = do
 
 type MethodBody = Either T.Text [Variant]
 
-callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody
+callMethod' :: (MonadUnliftIO m, SafeClient c) => c -> MethodCall -> m MethodBody
 callMethod' cl =
-  fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
+  liftIO
+    . fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
     . call (toClient cl)
 
 callMethod
-  :: SafeClient c
+  :: (MonadUnliftIO m, SafeClient c)
   => c
   -> BusName
   -> ObjectPath
   -> InterfaceName
   -> MemberName
-  -> IO MethodBody
+  -> m MethodBody
 callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
 
 methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
@@ -115,7 +116,7 @@ methodCallBus b p i m =
 dbusInterface :: InterfaceName
 dbusInterface = interfaceName_ "org.freedesktop.DBus"
 
-callGetNameOwner :: SafeClient c => c -> BusName -> IO (Maybe BusName)
+callGetNameOwner :: (MonadUnliftIO m, SafeClient c) => c -> BusName -> m (Maybe BusName)
 callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
   where
     mc =
@@ -139,12 +140,12 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant
 type SignalCallback = [Variant] -> IO ()
 
 addMatchCallback
-  :: SafeClient c
+  :: (MonadUnliftIO m, SafeClient c)
   => MatchRule
   -> SignalCallback
   -> c
-  -> IO SignalHandler
-addMatchCallback rule cb cl = addMatch (toClient cl) rule $ cb . signalBody
+  -> m SignalHandler
+addMatchCallback rule cb cl = liftIO . addMatch (toClient cl) rule $ cb . signalBody
 
 matchSignal
   :: Maybe BusName
@@ -161,13 +162,13 @@ matchSignal b p i m =
     }
 
 matchSignalFull
-  :: SafeClient c
+  :: (MonadUnliftIO m, SafeClient c)
   => c
   -> BusName
   -> Maybe ObjectPath
   -> Maybe InterfaceName
   -> Maybe MemberName
-  -> IO (Maybe MatchRule)
+  -> m (Maybe MatchRule)
 matchSignalFull client b p i m =
   fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
 
@@ -181,34 +182,35 @@ propertySignal :: MemberName
 propertySignal = memberName_ "PropertiesChanged"
 
 callPropertyGet
-  :: SafeClient c
+  :: (MonadUnliftIO m, SafeClient c)
   => BusName
   -> ObjectPath
   -> InterfaceName
   -> MemberName
   -> c
-  -> IO [Variant]
+  -> m [Variant]
 callPropertyGet bus path iface property cl =
-  fmap (either (const []) (: [])) $
-    getProperty (toClient cl) $
-      methodCallBus bus path iface property
+  liftIO $
+    fmap (either (const []) (: [])) $
+      getProperty (toClient cl) $
+        methodCallBus bus path iface property
 
 matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
 matchProperty b p =
   matchSignal b p (Just propertyInterface) (Just propertySignal)
 
 matchPropertyFull
-  :: SafeClient c
+  :: (MonadUnliftIO m, SafeClient c)
   => c
   -> BusName
   -> Maybe ObjectPath
-  -> IO (Maybe MatchRule)
+  -> m (Maybe MatchRule)
 matchPropertyFull cl b p =
   matchSignalFull cl b p (Just propertyInterface) (Just propertySignal)
 
 data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show)
 
-withSignalMatch :: (Maybe a -> IO ()) -> SignalMatch a -> IO ()
+withSignalMatch :: MonadUnliftIO m => (Maybe a -> m ()) -> SignalMatch a -> m ()
 withSignalMatch f (Match x) = f (Just x)
 withSignalMatch f Failure = f Nothing
 withSignalMatch _ NoMatch = return ()
@@ -250,43 +252,43 @@ omInterfacesRemoved :: MemberName
 omInterfacesRemoved = memberName_ "InterfacesRemoved"
 
 callGetManagedObjects
-  :: SafeClient c
+  :: (MonadUnliftIO m, SafeClient c)
   => c
   -> BusName
   -> ObjectPath
-  -> IO ObjectTree
+  -> m ObjectTree
 callGetManagedObjects cl bus path =
   either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
     <$> callMethod cl bus path omInterface getManagedObjects
 
 addInterfaceChangedListener
-  :: SafeClient c
+  :: (MonadUnliftIO m, SafeClient c)
   => BusName
   -> MemberName
   -> ObjectPath
   -> SignalCallback
   -> c
-  -> IO (Maybe SignalHandler)
+  -> m (Maybe SignalHandler)
 addInterfaceChangedListener bus prop path sc cl = do
   rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
   forM rule $ \r -> addMatchCallback r sc cl
 
 addInterfaceAddedListener
-  :: SafeClient c
+  :: (MonadUnliftIO m, SafeClient c)
   => BusName
   -> ObjectPath
   -> SignalCallback
   -> c
-  -> IO (Maybe SignalHandler)
+  -> m (Maybe SignalHandler)
 addInterfaceAddedListener bus =
   addInterfaceChangedListener bus omInterfacesAdded
 
 addInterfaceRemovedListener
-  :: SafeClient c
+  :: (MonadUnliftIO m, SafeClient c)
   => BusName
   -> ObjectPath
   -> SignalCallback
   -> c
-  -> IO (Maybe SignalHandler)
+  -> m (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
   addInterfaceChangedListener bus omInterfacesRemoved

From 4aae54b90e70bb51a2f8259ca54d96865ac56a4e Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 16:37:52 -0500
Subject: [PATCH 030/118] ENH generalize signal callbacks

---
 lib/Data/Internal/DBus.hs       | 13 +++++-----
 lib/Xmobar/Plugins/Bluetooth.hs | 44 ++++++++++++++++-----------------
 lib/Xmobar/Plugins/VPN.hs       | 31 ++++++++++++-----------
 3 files changed, 45 insertions(+), 43 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 51b2698..16fcc7b 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -137,15 +137,16 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant
 --------------------------------------------------------------------------------
 -- Signals
 
-type SignalCallback = [Variant] -> IO ()
+type SignalCallback m = [Variant] -> m ()
 
 addMatchCallback
   :: (MonadUnliftIO m, SafeClient c)
   => MatchRule
-  -> SignalCallback
+  -> SignalCallback m
   -> c
   -> m SignalHandler
-addMatchCallback rule cb cl = liftIO . addMatch (toClient cl) rule $ cb . signalBody
+addMatchCallback rule cb cl = withRunInIO $ \run -> do
+  addMatch (toClient cl) rule $ run . cb . signalBody
 
 matchSignal
   :: Maybe BusName
@@ -266,7 +267,7 @@ addInterfaceChangedListener
   => BusName
   -> MemberName
   -> ObjectPath
-  -> SignalCallback
+  -> SignalCallback m
   -> c
   -> m (Maybe SignalHandler)
 addInterfaceChangedListener bus prop path sc cl = do
@@ -277,7 +278,7 @@ addInterfaceAddedListener
   :: (MonadUnliftIO m, SafeClient c)
   => BusName
   -> ObjectPath
-  -> SignalCallback
+  -> SignalCallback m
   -> c
   -> m (Maybe SignalHandler)
 addInterfaceAddedListener bus =
@@ -287,7 +288,7 @@ addInterfaceRemovedListener
   :: (MonadUnliftIO m, SafeClient c)
   => BusName
   -> ObjectPath
-  -> SignalCallback
+  -> SignalCallback m
   -> c
   -> m (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 0ae39e0..488f533 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -39,7 +39,6 @@ module Xmobar.Plugins.Bluetooth
   )
 where
 
-import Control.Concurrent.MVar
 import Control.Monad
 import DBus
 import DBus.Client
@@ -49,6 +48,7 @@ import Data.List
 import Data.List.Split
 import qualified Data.Map as M
 import Data.Maybe
+import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Common
 import Xmobar
@@ -73,19 +73,19 @@ startAdapter :: Icons -> Colors -> Callback -> SysClient -> IO ()
 startAdapter is cs cb cl = do
   ot <- getBtObjectTree cl
   state <- newMVar emptyState
-  let display = displayIcon cb (iconFormatter is cs) state
+  let dpy = displayIcon cb (iconFormatter is cs) state
   forM_ (findAdapter ot) $ \adapter -> do
     -- set up adapter
     initAdapter state adapter cl
     -- TODO this step could fail; at least warn the user...
-    void $ addAdaptorListener state display adapter cl
+    void $ addAdaptorListener state dpy adapter cl
     -- set up devices on the adapter (and listeners for adding/removing devices)
     let devices = findDevices adapter ot
-    addDeviceAddedListener state display adapter cl
-    addDeviceRemovedListener state display adapter cl
-    forM_ devices $ \d -> addAndInitDevice state display d cl
+    addDeviceAddedListener state dpy adapter cl
+    addDeviceRemovedListener state dpy adapter cl
+    forM_ devices $ \d -> addAndInitDevice state dpy d cl
     -- after setting things up, show the icon based on the initialized state
-    display
+    dpy
 
 --------------------------------------------------------------------------------
 -- Icon Display
@@ -166,27 +166,27 @@ getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
 btOMPath :: ObjectPath
 btOMPath = objectPath_ "/"
 
-addBtOMListener :: SignalCallback -> SysClient -> IO ()
+addBtOMListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
 addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
 
 addDeviceAddedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-addDeviceAddedListener state display adapter client =
+addDeviceAddedListener state dpy adapter client =
   addBtOMListener addDevice client
   where
-    addDevice = pathCallback adapter display $ \d ->
-      addAndInitDevice state display d client
+    addDevice = pathCallback adapter dpy $ \d ->
+      addAndInitDevice state dpy d client
 
 addDeviceRemovedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-addDeviceRemovedListener state display adapter sys =
+addDeviceRemovedListener state dpy adapter sys =
   addBtOMListener remDevice sys
   where
-    remDevice = pathCallback adapter display $ \d -> do
+    remDevice = pathCallback adapter dpy $ \d -> do
       old <- removeDevice state d
       forM_ old $ removeMatch (toClient sys) . btDevSigHandler
 
-pathCallback :: ObjectPath -> IO () -> (ObjectPath -> IO ()) -> SignalCallback
-pathCallback adapter display f [device, _] = forM_ (fromVariant device) $ \d ->
-  when (adaptorHasDevice adapter d) $ f d >> display
+pathCallback :: MonadUnliftIO m => ObjectPath -> IO () -> (ObjectPath -> IO ()) -> SignalCallback m
+pathCallback adapter dpy f [device, _] = liftIO $ forM_ (fromVariant device) $ \d ->
+  when (adaptorHasDevice adapter d) $ f d >> dpy
 pathCallback _ _ _ _ = return ()
 
 --------------------------------------------------------------------------------
@@ -206,11 +206,11 @@ addAdaptorListener
   -> ObjectPath
   -> SysClient
   -> IO (Maybe SignalHandler)
-addAdaptorListener state display adaptor sys = do
+addAdaptorListener state dpy adaptor sys = do
   rule <- matchBTProperty sys adaptor
   forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) sys
   where
-    procMatch = withSignalMatch $ \b -> putPowered state b >> display
+    procMatch = withSignalMatch $ \b -> putPowered state b >> dpy
 
 callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
 callGetPowered adapter =
@@ -237,8 +237,8 @@ adaptorPowered = "Powered"
 -- Devices
 
 addAndInitDevice :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-addAndInitDevice state display device client = do
-  sh <- addDeviceListener state display device client
+addAndInitDevice state dpy device client = do
+  sh <- addDeviceListener state dpy device client
   -- TODO add some intelligent error messages here
   forM_ sh $ \s -> initDevice state s device client
 
@@ -258,11 +258,11 @@ addDeviceListener
   -> ObjectPath
   -> SysClient
   -> IO (Maybe SignalHandler)
-addDeviceListener state display device sys = do
+addDeviceListener state dpy device sys = do
   rule <- matchBTProperty sys device
   forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) sys
   where
-    procMatch = withSignalMatch $ \c -> updateDevice state device c >> display
+    procMatch = withSignalMatch $ \c -> updateDevice state device c >> dpy
 
 matchConnected :: [Variant] -> SignalMatch Bool
 matchConnected = matchPropertyChanged devInterface devConnected
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index a742134..3ccf837 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -14,14 +14,13 @@ module Xmobar.Plugins.VPN
   )
 where
 
-import Control.Concurrent.MVar
-import Control.Monad
 import DBus
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import qualified Data.Map as M
 import Data.Maybe
 import qualified Data.Set as S
+import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
@@ -35,11 +34,11 @@ instance Exec VPN where
   start (VPN (text, colors)) cb =
     withDBusClientConnection cb $ \c -> do
       state <- initState c
-      let display = displayMaybe cb iconFormatter . Just =<< readState state
-      let signalCallback' f = f state display
+      let dpy = displayMaybe cb iconFormatter . Just =<< readState state
+      let signalCallback' f = f state dpy
       vpnAddedListener (signalCallback' addedCallback) c
       vpnRemovedListener (signalCallback' removedCallback) c
-      display
+      dpy
     where
       iconFormatter b = return $ colorText colors b text
 
@@ -63,10 +62,11 @@ readState :: MutableVPNState -> IO Bool
 readState = fmap (not . null) . readMVar
 
 updateState
-  :: (ObjectPath -> VPNState -> VPNState)
+  :: MonadUnliftIO m
+  => (ObjectPath -> VPNState -> VPNState)
   -> MutableVPNState
   -> ObjectPath
-  -> IO ()
+  -> m ()
 updateState f state op = modifyMVar_ state $ return . f op
 
 --------------------------------------------------------------------------------
@@ -78,33 +78,34 @@ getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
 findTunnels :: ObjectTree -> VPNState
 findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
 
-vpnAddedListener :: SignalCallback -> SysClient -> IO ()
+vpnAddedListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
 vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
 
-vpnRemovedListener :: SignalCallback -> SysClient -> IO ()
+vpnRemovedListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
 vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
 
-addedCallback :: MutableVPNState -> IO () -> SignalCallback
-addedCallback state display [device, added] = update >> display
+addedCallback :: MonadUnliftIO m => MutableVPNState -> m () -> SignalCallback m
+addedCallback state dpy [device, added] = update >> dpy
   where
     added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant))
     is = M.keys $ fromMaybe M.empty added'
     update = updateDevice S.insert state device is
 addedCallback _ _ _ = return ()
 
-removedCallback :: MutableVPNState -> IO () -> SignalCallback
-removedCallback state display [device, interfaces] = update >> display
+removedCallback :: MonadUnliftIO m => MutableVPNState -> m () -> SignalCallback m
+removedCallback state dpy [device, interfaces] = update >> dpy
   where
     is = fromMaybe [] $ fromVariant interfaces :: [T.Text]
     update = updateDevice S.delete state device is
 removedCallback _ _ _ = return ()
 
 updateDevice
-  :: (ObjectPath -> VPNState -> VPNState)
+  :: MonadUnliftIO m
+  => (ObjectPath -> VPNState -> VPNState)
   -> MutableVPNState
   -> Variant
   -> [T.Text]
-  -> IO ()
+  -> m ()
 updateDevice f state device interfaces =
   when (vpnDeviceTun `elem` interfaces) $
     forM_ d $

From cc0465194a8e7d788e53db4e8aa35d5520d20c87 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 16:44:00 -0500
Subject: [PATCH 031/118] ENH generalize common plugin interfaces

---
 lib/Xmobar/Plugins/Common.hs | 27 ++++++++++++++++-----------
 1 file changed, 16 insertions(+), 11 deletions(-)

diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs
index f6bde99..98b9acc 100644
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@@ -15,10 +15,10 @@ module Xmobar.Plugins.Common
   )
 where
 
-import Control.Monad
 import DBus
 import DBus.Client
 import Data.Internal.DBus
+import RIO
 import qualified RIO.Text as T
 import XMonad.Hooks.DynamicLog (xmobarColor)
 
@@ -32,14 +32,14 @@ data Colors = Colors
   deriving (Eq, Show, Read)
 
 startListener
-  :: (SafeClient c, IsVariant a)
+  :: (MonadUnliftIO m, SafeClient c, IsVariant a)
   => MatchRule
-  -> (c -> IO [Variant])
+  -> (c -> m [Variant])
   -> ([Variant] -> SignalMatch a)
-  -> (a -> IO T.Text)
+  -> (a -> m T.Text)
   -> Callback
   -> c
-  -> IO ()
+  -> m ()
 startListener rule getProp fromSignal toColor cb client = do
   reply <- getProp client
   displayMaybe cb toColor $ fromSingletonVariant reply
@@ -47,7 +47,8 @@ startListener rule getProp fromSignal toColor cb client = do
   where
     procMatch = procSignalMatch cb toColor
 
-procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO ()
+procSignalMatch
+  :: MonadUnliftIO m => Callback -> (a -> m T.Text) -> SignalMatch a -> m ()
 procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
 
 colorText :: Colors -> Bool -> T.Text -> T.Text
@@ -60,11 +61,15 @@ xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack
 na :: T.Text
 na = "N/A"
 
-displayMaybe :: Callback -> (a -> IO T.Text) -> Maybe a -> IO ()
-displayMaybe cb f = (cb . T.unpack) <=< maybe (return na) f
+displayMaybe :: MonadUnliftIO m => Callback -> (a -> m T.Text) -> Maybe a -> m ()
+displayMaybe cb f = (liftIO . cb . T.unpack) <=< maybe (return na) f
 
-displayMaybe' :: Callback -> (a -> IO ()) -> Maybe a -> IO ()
-displayMaybe' cb = maybe (cb $ T.unpack na)
+displayMaybe' :: MonadUnliftIO m => Callback -> (a -> m ()) -> Maybe a -> m ()
+displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na)
 
-withDBusClientConnection :: SafeClient c => Callback -> (c -> IO ()) -> IO ()
+withDBusClientConnection
+  :: (MonadUnliftIO m, SafeClient c)
+  => Callback
+  -> (c -> m ())
+  -> m ()
 withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient

From 6738f8a4c7a5de10962e90ec034da2e85e079845 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 16:58:21 -0500
Subject: [PATCH 032/118] ENH generalize backlight common plugin

---
 lib/Xmobar/Plugins/BacklightCommon.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs
index f496fe3..2fd17b0 100644
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@@ -7,20 +7,21 @@
 module Xmobar.Plugins.BacklightCommon (startBacklight) where
 
 import Data.Internal.DBus
+import RIO
 import qualified RIO.Text as T
 import Xmobar.Plugins.Common
 
 startBacklight
-  :: RealFrac a
-  => ((Maybe a -> IO ()) -> SesClient -> IO ())
-  -> (SesClient -> IO (Maybe a))
+  :: (MonadUnliftIO m, RealFrac a)
+  => ((Maybe a -> m ()) -> SesClient -> m ())
+  -> (SesClient -> m (Maybe a))
   -> T.Text
   -> Callback
-  -> IO ()
+  -> m ()
 startBacklight matchSignal callGetBrightness icon cb = do
   withDBusClientConnection cb $ \c -> do
-    matchSignal display c
-    display =<< callGetBrightness c
+    matchSignal dpy c
+    dpy =<< callGetBrightness c
   where
     formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"]
-    display = displayMaybe cb formatBrightness
+    dpy = displayMaybe cb formatBrightness

From c394a655237e7f7f4cae9efc3f40bebf64752fd8 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 16:58:30 -0500
Subject: [PATCH 033/118] ENH generalize bluetooth

---
 lib/Xmobar/Plugins/Bluetooth.hs | 111 ++++++++++++++++++++++++--------
 1 file changed, 83 insertions(+), 28 deletions(-)

diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 488f533..12e8298 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -69,7 +69,13 @@ instance Exec Bluetooth where
   start (Bluetooth icons colors) cb =
     withDBusClientConnection cb $ startAdapter icons colors cb
 
-startAdapter :: Icons -> Colors -> Callback -> SysClient -> IO ()
+startAdapter
+  :: MonadUnliftIO m
+  => Icons
+  -> Colors
+  -> Callback
+  -> SysClient
+  -> m ()
 startAdapter is cs cb cl = do
   ot <- getBtObjectTree cl
   state <- newMVar emptyState
@@ -97,9 +103,9 @@ type IconFormatter = (Maybe Bool -> Bool -> T.Text)
 
 type Icons = (T.Text, T.Text)
 
-displayIcon :: Callback -> IconFormatter -> MutableBtState -> IO ()
+displayIcon :: MonadUnliftIO m => Callback -> IconFormatter -> MutableBtState -> m ()
 displayIcon callback formatter =
-  callback . T.unpack . uncurry formatter <=< readState
+  liftIO . callback . T.unpack . uncurry formatter <=< readState
 
 -- TODO maybe I want this to fail when any of the device statuses are Nothing
 iconFormatter :: Icons -> Colors -> IconFormatter
@@ -137,7 +143,7 @@ emptyState =
     , btPowered = Nothing
     }
 
-readState :: MutableBtState -> IO (Maybe Bool, Bool)
+readState :: MonadUnliftIO m => MutableBtState -> m (Maybe Bool, Bool)
 readState state = do
   p <- readPowered state
   c <- readDevices state
@@ -160,7 +166,7 @@ adaptorHasDevice adaptor device = case splitPath device of
 splitPath :: ObjectPath -> [T.Text]
 splitPath = fmap T.pack . splitOn "/" . dropWhile (== '/') . formatObjectPath
 
-getBtObjectTree :: SysClient -> IO ObjectTree
+getBtObjectTree :: MonadUnliftIO m => SysClient -> m ObjectTree
 getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
 
 btOMPath :: ObjectPath
@@ -169,50 +175,72 @@ btOMPath = objectPath_ "/"
 addBtOMListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
 addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
 
-addDeviceAddedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
+addDeviceAddedListener
+  :: MonadUnliftIO m
+  => MutableBtState
+  -> m ()
+  -> ObjectPath
+  -> SysClient
+  -> m ()
 addDeviceAddedListener state dpy adapter client =
   addBtOMListener addDevice client
   where
     addDevice = pathCallback adapter dpy $ \d ->
       addAndInitDevice state dpy d client
 
-addDeviceRemovedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
+addDeviceRemovedListener
+  :: (MonadUnliftIO m)
+  => MutableBtState
+  -> m ()
+  -> ObjectPath
+  -> SysClient
+  -> m ()
 addDeviceRemovedListener state dpy adapter sys =
   addBtOMListener remDevice sys
   where
     remDevice = pathCallback adapter dpy $ \d -> do
       old <- removeDevice state d
-      forM_ old $ removeMatch (toClient sys) . btDevSigHandler
+      forM_ old $ liftIO . removeMatch (toClient sys) . btDevSigHandler
 
-pathCallback :: MonadUnliftIO m => ObjectPath -> IO () -> (ObjectPath -> IO ()) -> SignalCallback m
-pathCallback adapter dpy f [device, _] = liftIO $ forM_ (fromVariant device) $ \d ->
+pathCallback :: MonadUnliftIO m => ObjectPath -> m () -> (ObjectPath -> m ()) -> SignalCallback m
+pathCallback adapter dpy f [device, _] = forM_ (fromVariant device) $ \d ->
   when (adaptorHasDevice adapter d) $ f d >> dpy
 pathCallback _ _ _ _ = return ()
 
 --------------------------------------------------------------------------------
 -- Adapter
 
-initAdapter :: MutableBtState -> ObjectPath -> SysClient -> IO ()
+initAdapter
+  :: (MonadUnliftIO m)
+  => MutableBtState
+  -> ObjectPath
+  -> SysClient
+  -> m ()
 initAdapter state adapter client = do
   reply <- callGetPowered adapter client
   putPowered state $ fromSingletonVariant reply
 
-matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule)
+matchBTProperty
+  :: (MonadUnliftIO m)
+  => SysClient
+  -> ObjectPath
+  -> m (Maybe MatchRule)
 matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
 
 addAdaptorListener
-  :: MutableBtState
-  -> IO ()
+  :: MonadUnliftIO m
+  => MutableBtState
+  -> m ()
   -> ObjectPath
   -> SysClient
-  -> IO (Maybe SignalHandler)
+  -> m (Maybe SignalHandler)
 addAdaptorListener state dpy adaptor sys = do
   rule <- matchBTProperty sys adaptor
   forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) sys
   where
     procMatch = withSignalMatch $ \b -> putPowered state b >> dpy
 
-callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
+callGetPowered :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
 callGetPowered adapter =
   callPropertyGet btBus adapter adapterInterface $
     memberName_ $
@@ -221,10 +249,10 @@ callGetPowered adapter =
 matchPowered :: [Variant] -> SignalMatch Bool
 matchPowered = matchPropertyChanged adapterInterface adaptorPowered
 
-putPowered :: MutableBtState -> Maybe Bool -> IO ()
+putPowered :: MonadUnliftIO m => MutableBtState -> Maybe Bool -> m ()
 putPowered m ds = modifyMVar_ m (\s -> return s {btPowered = ds})
 
-readPowered :: MutableBtState -> IO (Maybe Bool)
+readPowered :: MonadUnliftIO m => MutableBtState -> m (Maybe Bool)
 readPowered = fmap btPowered . readMVar
 
 adapterInterface :: InterfaceName
@@ -236,13 +264,25 @@ adaptorPowered = "Powered"
 --------------------------------------------------------------------------------
 -- Devices
 
-addAndInitDevice :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
+addAndInitDevice
+  :: MonadUnliftIO m
+  => MutableBtState
+  -> m ()
+  -> ObjectPath
+  -> SysClient
+  -> m ()
 addAndInitDevice state dpy device client = do
   sh <- addDeviceListener state dpy device client
   -- TODO add some intelligent error messages here
   forM_ sh $ \s -> initDevice state s device client
 
-initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO ()
+initDevice
+  :: MonadUnliftIO m
+  => MutableBtState
+  -> SignalHandler
+  -> ObjectPath
+  -> SysClient
+  -> m ()
 initDevice state sh device sys = do
   reply <- callGetConnected device sys
   void $
@@ -253,11 +293,12 @@ initDevice state sh device sys = do
         }
 
 addDeviceListener
-  :: MutableBtState
-  -> IO ()
+  :: MonadUnliftIO m
+  => MutableBtState
+  -> m ()
   -> ObjectPath
   -> SysClient
-  -> IO (Maybe SignalHandler)
+  -> m (Maybe SignalHandler)
 addDeviceListener state dpy device sys = do
   rule <- matchBTProperty sys device
   forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) sys
@@ -267,17 +308,27 @@ addDeviceListener state dpy device sys = do
 matchConnected :: [Variant] -> SignalMatch Bool
 matchConnected = matchPropertyChanged devInterface devConnected
 
-callGetConnected :: ObjectPath -> SysClient -> IO [Variant]
+callGetConnected :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
 callGetConnected p =
   callPropertyGet btBus p devInterface $
     memberName_ (T.unpack devConnected)
 
-insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool
+insertDevice
+  :: MonadUnliftIO m
+  => MutableBtState
+  -> ObjectPath
+  -> BTDevice
+  -> m Bool
 insertDevice m device dev = modifyMVar m $ \s -> do
   let new = M.insert device dev $ btDevices s
   return (s {btDevices = new}, anyDevicesConnected new)
 
-updateDevice :: MutableBtState -> ObjectPath -> Maybe Bool -> IO Bool
+updateDevice
+  :: MonadUnliftIO m
+  => MutableBtState
+  -> ObjectPath
+  -> Maybe Bool
+  -> m Bool
 updateDevice m device status = modifyMVar m $ \s -> do
   let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s
   return (s {btDevices = new}, anyDevicesConnected new)
@@ -285,12 +336,16 @@ updateDevice m device status = modifyMVar m $ \s -> do
 anyDevicesConnected :: ConnectedDevices -> Bool
 anyDevicesConnected = or . mapMaybe btDevConnected . M.elems
 
-removeDevice :: MutableBtState -> ObjectPath -> IO (Maybe BTDevice)
+removeDevice
+  :: MonadUnliftIO m
+  => MutableBtState
+  -> ObjectPath
+  -> m (Maybe BTDevice)
 removeDevice m device = modifyMVar m $ \s -> do
   let devs = btDevices s
   return (s {btDevices = M.delete device devs}, M.lookup device devs)
 
-readDevices :: MutableBtState -> IO ConnectedDevices
+readDevices :: MonadUnliftIO m => MutableBtState -> m ConnectedDevices
 readDevices = fmap btDevices . readMVar
 
 devInterface :: InterfaceName

From f39762e1e8832213ee4bf3f119d86b44afe8d0b3 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 16:59:50 -0500
Subject: [PATCH 034/118] ENH generalize device plugin

---
 lib/Xmobar/Plugins/Device.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index 42e992b..1c309ae 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -12,11 +12,11 @@ module Xmobar.Plugins.Device
   )
 where
 
-import Control.Monad
 import DBus
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import Data.Word
+import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
@@ -45,7 +45,7 @@ devDep =
   Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
     Method_ getByIP
 
-getDevice :: SysClient -> T.Text -> IO (Maybe ObjectPath)
+getDevice :: MonadUnliftIO m => SysClient -> T.Text -> m (Maybe ObjectPath)
 getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
   where
     mc =
@@ -53,7 +53,7 @@ getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
         { methodCallBody = [toVariant iface]
         }
 
-getDeviceConnected :: ObjectPath -> SysClient -> IO [Variant]
+getDeviceConnected :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
 getDeviceConnected path =
   callPropertyGet networkManagerBus path nmDeviceInterface $
     memberName_ $

From c36a63e251ab808f871566d840781d2599c477a4 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 17:02:23 -0500
Subject: [PATCH 035/118] ENH generalize vpn plugin

---
 lib/Xmobar/Plugins/VPN.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index 3ccf837..309938e 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -53,12 +53,12 @@ type VPNState = S.Set ObjectPath
 
 type MutableVPNState = MVar VPNState
 
-initState :: SysClient -> IO MutableVPNState
+initState :: MonadUnliftIO m => SysClient -> m MutableVPNState
 initState client = do
   ot <- getVPNObjectTree client
   newMVar $ findTunnels ot
 
-readState :: MutableVPNState -> IO Bool
+readState :: MonadUnliftIO m => MutableVPNState -> m Bool
 readState = fmap (not . null) . readMVar
 
 updateState
@@ -72,7 +72,7 @@ updateState f state op = modifyMVar_ state $ return . f op
 --------------------------------------------------------------------------------
 -- Tunnel Device Detection
 
-getVPNObjectTree :: SysClient -> IO ObjectTree
+getVPNObjectTree :: MonadUnliftIO m => SysClient -> m ObjectTree
 getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
 
 findTunnels :: ObjectTree -> VPNState

From e508f29bd88a89c7255bd48655d19beaea29d034 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 17:11:06 -0500
Subject: [PATCH 036/118] ENH generalize dbus controls

---
 lib/XMonad/Internal/DBus/Control.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index cc910e6..0f43ac4 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -18,11 +18,11 @@ module XMonad.Internal.DBus.Control
   )
 where
 
-import Control.Monad
 import DBus
 import DBus.Client
 import Data.Internal.DBus
 import Data.Internal.Dependency
+import RIO
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import XMonad.Internal.DBus.Brightness.IntelBacklight
 import XMonad.Internal.DBus.Common
@@ -35,27 +35,27 @@ data DBusState = DBusState
   }
 
 -- | Connect to the DBus
-connectDBus :: IO DBusState
+connectDBus :: MonadUnliftIO m => m DBusState
 connectDBus = do
   ses <- getDBusClient
   sys <- getDBusClient
   return DBusState {dbSesClient = ses, dbSysClient = sys}
 
 -- | Disconnect from the DBus
-disconnectDBus :: DBusState -> IO ()
+disconnectDBus :: MonadUnliftIO m => DBusState -> m ()
 disconnectDBus db = disc dbSesClient >> disc dbSysClient
   where
     disc f = maybe (return ()) disconnectDBusClient $ f db
 
 -- | Connect to the DBus and request the XMonad name
-connectDBusX :: IO DBusState
+connectDBusX :: MonadUnliftIO m => m DBusState
 connectDBusX = do
   db <- connectDBus
   forM_ (dbSesClient db) requestXMonadName
   return db
 
 -- | Disconnect from DBus and release the XMonad name
-disconnectDBusX :: DBusState -> IO ()
+disconnectDBusX :: MonadUnliftIO m => DBusState -> m ()
 disconnectDBusX db = do
   forM_ (dbSesClient db) releaseXMonadName
   disconnectDBus db
@@ -64,12 +64,12 @@ disconnectDBusX db = do
 dbusExporters :: [Maybe SesClient -> SometimesIO]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 
-releaseXMonadName :: SesClient -> IO ()
-releaseXMonadName ses = void $ releaseName (toClient ses) xmonadBusName
+releaseXMonadName :: MonadUnliftIO m => SesClient -> m ()
+releaseXMonadName ses = liftIO $ void $ releaseName (toClient ses) xmonadBusName
 
-requestXMonadName :: SesClient -> IO ()
+requestXMonadName :: MonadUnliftIO m => SesClient -> m ()
 requestXMonadName ses = do
-  res <- requestName (toClient ses) xmonadBusName []
+  res <- liftIO $ requestName (toClient ses) xmonadBusName []
   -- TODO if the client is not released on shutdown the owner will be different
   let msg
         | res == NamePrimaryOwner = Nothing
@@ -78,6 +78,6 @@ requestXMonadName ses = do
             || res == NameExists =
             Just $ "another process owns " ++ xn
         | otherwise = Just $ "unknown error when requesting " ++ xn
-  forM_ msg putStrLn
+  liftIO $ forM_ msg putStrLn
   where
     xn = "'" ++ formatBusName xmonadBusName ++ "'"

From b9a10df606abefe32a4a228441b90b0c6f9c48b2 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 17:11:15 -0500
Subject: [PATCH 037/118] ENH generalize brightness

---
 lib/XMonad/Internal/DBus/Brightness/Common.hs | 22 +++++++++++--------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index e767c77..2033ca5 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -14,13 +14,12 @@ module XMonad.Internal.DBus.Brightness.Common
   )
 where
 
-import Control.Monad (void)
 import DBus
 import DBus.Client
 import qualified DBus.Introspection as I
-import Data.Int (Int32)
 import Data.Internal.DBus
 import Data.Internal.Dependency
+import RIO
 import qualified RIO.Text as T
 import XMonad.Core (io)
 import XMonad.Internal.DBus.Common
@@ -69,10 +68,10 @@ brightnessControls q bc cl =
     cb = callBacklight q cl bc
 
 callGetBrightness
-  :: (SafeClient c, Num n)
+  :: (MonadUnliftIO m, SafeClient c, Num n)
   => BrightnessConfig a b
   -> c
-  -> IO (Maybe n)
+  -> m (Maybe n)
 callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} client =
   either (const Nothing) bodyGetBrightness
     <$> callMethod client xmonadBusName p i memGet
@@ -82,11 +81,11 @@ signalDep BrightnessConfig {bcPath = p, bcInterface = i} =
   Endpoint [] xmonadBusName p i $ Signal_ memCur
 
 matchSignal
-  :: (SafeClient c, Num n)
+  :: (MonadUnliftIO m, SafeClient c, Num n)
   => BrightnessConfig a b
-  -> (Maybe n -> IO ())
+  -> (Maybe n -> m ())
   -> c
-  -> IO ()
+  -> m ()
 matchSignal BrightnessConfig {bcPath = p, bcInterface = i} cb =
   void . addMatchCallback brMatcher (cb . bodyGetBrightness)
   where
@@ -148,9 +147,14 @@ exportBrightnessControls' bc cl = io $ do
             ]
         }
 
-emitBrightness :: RealFrac b => BrightnessConfig a b -> Client -> b -> IO ()
+emitBrightness
+  :: (MonadUnliftIO m, RealFrac b)
+  => BrightnessConfig a b
+  -> Client
+  -> b
+  -> m ()
 emitBrightness BrightnessConfig {bcPath = p, bcInterface = i} client cur =
-  emit client $ sig {signalBody = [toVariant (round cur :: Int32)]}
+  liftIO $ emit client $ sig {signalBody = [toVariant (round cur :: Int32)]}
   where
     sig = signal p i memCur
 

From 98358983de086946b2b1e9bb0ce415d4f9a2abd9 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 30 Dec 2022 17:15:50 -0500
Subject: [PATCH 038/118] REF reformat

---
 lib/XMonad/Internal/DBus/Brightness/Common.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 2033ca5..7f336f4 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -114,7 +114,11 @@ brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
     root = DBusRoot_ (exportBrightnessControls' bc) tree cl
     tree = listToAnds (Bus ful xmonadBusName) $ fmap DBusIO deps
 
-exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> SesClient -> FIO ()
+exportBrightnessControls'
+  :: (MonadUnliftIO m, RealFrac b)
+  => BrightnessConfig a b
+  -> SesClient
+  -> m ()
 exportBrightnessControls' bc cl = io $ do
   let ses = toClient cl
   maxval <- bcGetMax bc -- assume the max value will never change

From 71c875702f9f2320896063bcbf1f8e552263c7e4 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 15:26:22 -0500
Subject: [PATCH 039/118] ENH generalize keyboard stuff

---
 lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs  | 11 +++++++----
 lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs | 10 +++++++---
 2 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
index c673898..8352949 100644
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@@ -13,11 +13,10 @@ module XMonad.Internal.DBus.Brightness.ClevoKeyboard
   )
 where
 
-import Control.Monad (when)
 import DBus
-import Data.Int (Int32)
 import Data.Internal.DBus
 import Data.Internal.Dependency
+import RIO
 import RIO.FilePath
 import XMonad.Internal.DBus.Brightness.Common
 import XMonad.Internal.IO
@@ -127,8 +126,12 @@ exportClevoKeyboard =
 clevoKeyboardControls :: Maybe SesClient -> BrightnessControls
 clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
 
-callGetBrightnessCK :: SesClient -> IO (Maybe Brightness)
+callGetBrightnessCK :: MonadUnliftIO m => SesClient -> m (Maybe Brightness)
 callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
 
-matchSignalCK :: (Maybe Brightness -> IO ()) -> SesClient -> IO ()
+matchSignalCK
+  :: MonadUnliftIO m
+  => (Maybe Brightness -> m ())
+  -> SesClient
+  -> m ()
 matchSignalCK = matchSignal clevoKeyboardConfig
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index 21a3f94..0858fed 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@@ -14,9 +14,9 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
 where
 
 import DBus
-import Data.Int (Int32)
 import Data.Internal.DBus
 import Data.Internal.Dependency
+import RIO
 import RIO.FilePath
 import XMonad.Internal.DBus.Brightness.Common
 import XMonad.Internal.IO
@@ -110,8 +110,12 @@ exportIntelBacklight =
 intelBacklightControls :: Maybe SesClient -> BrightnessControls
 intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig
 
-callGetBrightnessIB :: SesClient -> IO (Maybe Brightness)
+callGetBrightnessIB :: MonadUnliftIO m => SesClient -> m (Maybe Brightness)
 callGetBrightnessIB = callGetBrightness intelBacklightConfig
 
-matchSignalIB :: (Maybe Brightness -> IO ()) -> SesClient -> IO ()
+matchSignalIB
+  :: MonadUnliftIO m
+  => (Maybe Brightness -> m ())
+  -> SesClient
+  -> m ()
 matchSignalIB = matchSignal intelBacklightConfig

From c13de68d4f9347b4e7edeadd5e2f54c0b706d711 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 16:13:45 -0500
Subject: [PATCH 040/118] ENH generalize IO

---
 lib/XMonad/Internal/IO.hs | 60 ++++++++++++++++++++++++++-------------
 1 file changed, 41 insertions(+), 19 deletions(-)

diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs
index ed6a8a9..47b7862 100644
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@@ -26,29 +26,28 @@ module XMonad.Internal.IO
 where
 
 import Data.Char
-import Data.Text (pack, unpack)
-import Data.Text.IO as T (readFile, writeFile)
 import RIO
 import RIO.Directory
 import RIO.FilePath
+import qualified RIO.Text as T
 import System.IO.Error
 
 --------------------------------------------------------------------------------
 -- read
 
-readInt :: (Read a, Integral a) => FilePath -> IO a
-readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile
+readInt :: MonadIO m => (Read a, Integral a) => FilePath -> m a
+readInt = fmap (read . takeWhile isDigit . T.unpack) . readFileUtf8
 
-readBool :: FilePath -> IO Bool
+readBool :: MonadIO m => FilePath -> m Bool
 readBool = fmap (== (1 :: Int)) . readInt
 
 --------------------------------------------------------------------------------
 -- write
 
-writeInt :: (Show a, Integral a) => FilePath -> a -> IO ()
-writeInt f = T.writeFile f . pack . show
+writeInt :: MonadIO m => (Show a, Integral a) => FilePath -> a -> m ()
+writeInt f = writeFileUtf8 f . T.pack . show
 
-writeBool :: FilePath -> Bool -> IO ()
+writeBool :: MonadIO m => FilePath -> Bool -> m ()
 writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
 
 --------------------------------------------------------------------------------
@@ -64,7 +63,7 @@ rawToPercent (lower, upper) raw =
 
 -- rawToPercent upper raw = 100 * fromIntegral raw / fromIntegral upper
 
-readPercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
+readPercent :: MonadIO m => (Integral a, RealFrac b) => (a, a) -> FilePath -> m b
 readPercent bounds path = do
   i <- readInt path
   return $ rawToPercent bounds (i :: Integer)
@@ -74,7 +73,12 @@ percentToRaw (lower, upper) perc =
   round $
     fromIntegral lower + perc / 100.0 * (fromIntegral upper - fromIntegral lower)
 
-writePercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> b -> IO b
+writePercent
+  :: (MonadIO m, Integral a, RealFrac b)
+  => (a, a)
+  -> FilePath
+  -> b
+  -> m b
 writePercent bounds path perc = do
   let t
         | perc > 100 = 100
@@ -83,29 +87,47 @@ writePercent bounds path perc = do
   writeInt path (percentToRaw bounds t :: Int)
   return t
 
-writePercentMin :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
+writePercentMin
+  :: (MonadIO m, Integral a, RealFrac b)
+  => (a, a)
+  -> FilePath
+  -> m b
 writePercentMin bounds path = writePercent bounds path 0
 
-writePercentMax :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
+writePercentMax
+  :: (MonadIO m, Integral a, RealFrac b)
+  => (a, a)
+  -> FilePath
+  -> m b
 writePercentMax bounds path = writePercent bounds path 100
 
 shiftPercent
-  :: (Integral a, RealFrac b)
+  :: (MonadIO m, Integral a, RealFrac b)
   => (b -> b -> b)
   -> Int
   -> FilePath
   -> (a, a)
-  -> IO b
+  -> m b
 shiftPercent f steps path bounds =
   writePercent bounds path . f stepsize
     =<< readPercent bounds path
   where
     stepsize = 100 / fromIntegral steps
 
-incPercent :: (Integral a, RealFrac b) => Int -> FilePath -> (a, a) -> IO b
+incPercent
+  :: (MonadIO m, Integral a, RealFrac b)
+  => Int
+  -> FilePath
+  -> (a, a)
+  -> m b
 incPercent = shiftPercent (+)
 
-decPercent :: (Integral a, RealFrac b) => Int -> FilePath -> (a, a) -> IO b
+decPercent
+  :: (MonadIO m, Integral a, RealFrac b)
+  => Int
+  -> FilePath
+  -> (a, a)
+  -> m b
 decPercent = shiftPercent subtract -- silly (-) operator thingy error
 
 --------------------------------------------------------------------------------
@@ -119,9 +141,9 @@ data PermResult a = PermResult a | NotFoundError | PermError
 --   fmap _ NotFoundError  = NotFoundError
 --   fmap _ PermError      = PermError
 
-getPermissionsSafe :: FilePath -> IO (PermResult Permissions)
+getPermissionsSafe :: MonadUnliftIO m => FilePath -> m (PermResult Permissions)
 getPermissionsSafe f = do
-  r <- tryIOError $ getPermissions f
+  r <- tryIO $ getPermissions f
   return $ case r of
     Right z -> PermResult z
     Left (isPermissionError -> True) -> PermError
@@ -139,7 +161,7 @@ getPermissionsSafe f = do
 -- | Block until a PID has exited.
 -- Use this to control flow based on a process that was not explicitly started
 -- by the Haskell runtime itself, and thus has no data structures to query.
-waitUntilExit :: (Show t, Num t) => t -> IO ()
+waitUntilExit :: (MonadIO m, Show t, Num t) => t -> m ()
 waitUntilExit pid = do
   res <- doesDirectoryExist $ "/proc" </> show pid
   when res $ do

From 7e9d7d6d4b38a42012cbd8ebe48ba7ee93ce50ef Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 16:18:51 -0500
Subject: [PATCH 041/118] ENH use better types for wait

---
 bin/vbox-start.hs         | 3 ++-
 lib/XMonad/Internal/IO.hs | 3 ++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/bin/vbox-start.hs b/bin/vbox-start.hs
index c918f38..57aecf2 100644
--- a/bin/vbox-start.hs
+++ b/bin/vbox-start.hs
@@ -21,6 +21,7 @@ import RIO
 import RIO.Process
 import qualified RIO.Text as T
 import System.Environment
+import System.Process (Pid)
 import Text.XML.Light
 import XMonad.Internal.Concurrent.VirtualBox
 import XMonad.Internal.IO
@@ -54,7 +55,7 @@ vmLaunch i = do
         "Failed to start VM: "
           <> displayBytesUtf8 (encodeUtf8 i)
 
-vmPID :: T.Text -> RIO SimpleApp (Maybe Int)
+vmPID :: T.Text -> RIO SimpleApp (Maybe Pid)
 vmPID vid = do
   (rc, out) <- proc "pgrep" ["-f", "VirtualBoxVM.*" ++ T.unpack vid] readProcessStdout
   return $ case rc of
diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs
index 47b7862..6023619 100644
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@@ -31,6 +31,7 @@ import RIO.Directory
 import RIO.FilePath
 import qualified RIO.Text as T
 import System.IO.Error
+import System.Process
 
 --------------------------------------------------------------------------------
 -- read
@@ -161,7 +162,7 @@ getPermissionsSafe f = do
 -- | Block until a PID has exited.
 -- Use this to control flow based on a process that was not explicitly started
 -- by the Haskell runtime itself, and thus has no data structures to query.
-waitUntilExit :: (MonadIO m, Show t, Num t) => t -> m ()
+waitUntilExit :: (MonadIO m) => Pid -> m ()
 waitUntilExit pid = do
   res <- doesDirectoryExist $ "/proc" </> show pid
   when res $ do

From e76050a7a128eb682cf23f5a85866ae3a5e40eeb Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 16:20:41 -0500
Subject: [PATCH 042/118] ENH generalize internal shell functions

---
 lib/XMonad/Internal/Shell.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index d44249f..70a3e6c 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -60,11 +60,11 @@ import qualified XMonad.Util.Run as XR
 -- In contrast with high-level APIs like 'System.Process', this will leave no
 -- trailing data structures to clean up, at the cost of being gross to look at
 -- and possibly more error-prone.
-runProcess :: P.ProcessConfig a b c -> IO ExitCode
+runProcess :: MonadUnliftIO m => P.ProcessConfig a b c -> m ExitCode
 runProcess = withDefaultSignalHandlers . P.runProcess
 
 -- | Run an action without xmonad's signal handlers.
-withDefaultSignalHandlers :: IO a -> IO a
+withDefaultSignalHandlers :: MonadUnliftIO m => m a -> m a
 withDefaultSignalHandlers =
   bracket_ X.uninstallSignalHandlers X.installSignalHandlers
 

From 044b4cddc044d5da4f3d32ee053696b6bb952a82 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 16:23:17 -0500
Subject: [PATCH 043/118] REF (kinda) remove dep lift functions

---
 lib/Data/Internal/Dependency.hs | 38 ++++++++++++++++-----------------
 1 file changed, 19 insertions(+), 19 deletions(-)

diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index 8ba3d44..510a38b 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -69,8 +69,8 @@ module Data.Internal.Dependency
   , readWireless
   , socketExists
   -- lifting
-  , ioSometimes
-  , ioAlways
+  -- , ioSometimes
+  -- , ioAlways
   -- feature construction
   , always1
   , sometimes1
@@ -905,28 +905,28 @@ testDBusDepNoCache_ _ (DBusIO i) = testIODepNoCache_ i
 --------------------------------------------------------------------------------
 -- IO Lifting functions
 
-ioSometimes :: MonadIO m => Sometimes (IO a) -> Sometimes (m a)
-ioSometimes (Sometimes n t xs) = Sometimes n t $ fmap ioSubfeature xs
+-- ioSometimes :: MonadIO m => Sometimes (IO a) -> Sometimes (m a)
+-- ioSometimes (Sometimes n t xs) = Sometimes n t $ fmap ioSubfeature xs
 
-ioAlways :: MonadIO m => Always (IO a) -> Always (m a)
-ioAlways (Always n x) = Always n $ ioAlways' x
+-- ioAlways :: MonadIO m => Always (IO a) -> Always (m a)
+-- ioAlways (Always n x) = Always n $ ioAlways' x
 
-ioAlways' :: MonadIO m => Always_ (IO a) -> Always_ (m a)
-ioAlways' (Always_ ar) = Always_ $ ioFallbackRoot ar
-ioAlways' (Option sf a) = Option (ioSubfeature sf) $ ioAlways' a
+-- ioAlways' :: MonadIO m => Always_ (IO a) -> Always_ (m a)
+-- ioAlways' (Always_ ar) = Always_ $ ioFallbackRoot ar
+-- ioAlways' (Option sf a) = Option (ioSubfeature sf) $ ioAlways' a
 
-ioFallbackRoot :: MonadIO m => FallbackRoot (IO a) -> FallbackRoot (m a)
-ioFallbackRoot (FallbackAlone a) = FallbackAlone $ io a
-ioFallbackRoot (FallbackTree a s) = FallbackTree (io . a) s
+-- ioFallbackRoot :: MonadIO m => FallbackRoot (IO a) -> FallbackRoot (m a)
+-- ioFallbackRoot (FallbackAlone a) = FallbackAlone $ io a
+-- ioFallbackRoot (FallbackTree a s) = FallbackTree (io . a) s
 
-ioSubfeature :: MonadIO m => SubfeatureRoot (IO a) -> SubfeatureRoot (m a)
-ioSubfeature sf = sf {sfData = ioRoot $ sfData sf}
+-- ioSubfeature :: MonadIO m => SubfeatureRoot (IO a) -> SubfeatureRoot (m a)
+-- ioSubfeature sf = sf {sfData = ioRoot $ sfData sf}
 
-ioRoot :: MonadIO m => Root (IO a) -> Root (m a)
-ioRoot (IORoot a t) = IORoot (io . a) t
-ioRoot (IORoot_ a t) = IORoot_ (io a) t
-ioRoot (DBusRoot a t cl) = DBusRoot (\p c -> io $ a p c) t cl
-ioRoot (DBusRoot_ a t cl) = DBusRoot_ (io . a) t cl
+-- ioRoot :: MonadIO m => Root (IO a) -> Root (m a)
+-- ioRoot (IORoot a t) = IORoot (io . a) t
+-- ioRoot (IORoot_ a t) = IORoot_ (io a) t
+-- ioRoot (DBusRoot a t cl) = DBusRoot (\p c -> io $ a p c) t cl
+-- ioRoot (DBusRoot_ a t cl) = DBusRoot_ (io . a) t cl
 
 --------------------------------------------------------------------------------
 -- Feature constructors

From 315f3a8f2447c3191ce8904925dca1977a27419e Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 19:04:37 -0500
Subject: [PATCH 044/118] ENH generalize dep IO functions

---
 lib/Data/Internal/Dependency.hs        | 49 +++++++++++++++-----------
 lib/XMonad/Internal/Command/Desktop.hs |  4 +--
 lib/XMonad/Internal/Command/Power.hs   |  2 +-
 package.yaml                           |  1 +
 4 files changed, 33 insertions(+), 23 deletions(-)

diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index 510a38b..cf104d8 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -114,14 +114,13 @@ import Data.Maybe
 import Data.Yaml
 import GHC.IO.Exception (ioe_description)
 import RIO hiding (bracket, fromString)
+import RIO.Directory
 import RIO.FilePath
 import RIO.Process hiding (findExecutable)
 import qualified RIO.Text as T
-import System.Directory
-import System.Environment
-import System.IO.Error
 import System.Posix.Files
 import System.Process.Typed (nullStream)
+import UnliftIO.Environment
 import XMonad.Core (X, io)
 import XMonad.Internal.IO
 import XMonad.Internal.Shell hiding (proc, runProcess)
@@ -484,16 +483,16 @@ defXPFeatures =
 
 type XPQuery = XPFeatures -> Bool
 
-getParams :: IO XParams
+getParams :: MonadIO m => m XParams
 getParams = do
   p <- getParamFile
-  maybe (return defParams) decodeYaml p
+  maybe (return defParams) (liftIO . decodeYaml) p
   where
     decodeYaml p =
       either (\e -> print e >> return defParams) return
         =<< decodeFileEither p
 
-getParamFile :: IO (Maybe FilePath)
+getParamFile :: MonadIO m => m (Maybe FilePath)
 getParamFile = do
   e <- lookupEnv "XDG_CONFIG_HOME"
   parent <- case e of
@@ -502,7 +501,7 @@ getParamFile = do
       | isRelative path -> fallback
       | otherwise -> return path
   let full = parent </> "xmonad.yml"
-  (\x -> if x then Just full else Nothing) <$> fileExist full
+  (\x -> if x then Just full else Nothing) <$> doesFileExist full
   where
     fallback = (</> ".config") <$> getHomeDirectory
 
@@ -682,9 +681,12 @@ testIODepNoCache_ (IOSometimes_ x) =
     <$> evalSometimesMsg x
 
 --------------------------------------------------------------------------------
+-- System Dependency Testing
 
--- | System Dependency Testing
-testSysDependency :: SystemDependency -> FIO (Maybe Msg)
+testSysDependency
+  :: (MonadUnliftIO m, MonadReader env m, HasProcessContext env, HasLogFunc env)
+  => SystemDependency
+  -> m (Maybe Msg)
 testSysDependency (Executable sys bin) =
   io $
     maybe (Just msg) (const Nothing)
@@ -713,7 +715,12 @@ testSysDependency (AccessiblePath p r w) = io $ permMsg <$> getPermissionsSafe p
         (_, Just False) -> mkErr "file not writable"
         _ -> Nothing
 
-shellTest :: FilePath -> [T.Text] -> T.Text -> FIO (Maybe Msg)
+shellTest
+  :: (MonadReader env m, HasProcessContext env, HasLogFunc env, MonadUnliftIO m)
+  => FilePath
+  -> [T.Text]
+  -> T.Text
+  -> m (Maybe Msg)
 shellTest cmd args msg = do
   rc <- proc cmd (T.unpack <$> args) (runProcess . setStdout nullStream)
   return $ case rc of
@@ -764,7 +771,10 @@ fontTestName fam = T.unwords ["test if font", singleQuote fam, "exists"]
 -- testFont :: T.Text -> FIO (Result FontBuilder)
 -- testFont = liftIO . testFont'
 
-testFont :: T.Text -> FIO (Result FontBuilder)
+testFont
+  :: (MonadUnliftIO m, MonadReader env m, HasProcessContext env, HasLogFunc env)
+  => T.Text
+  -> m (Result FontBuilder)
 testFont fam = maybe pass (Left . (: [])) <$> shellTest "fc-list" args msg
   where
     msg = T.unwords ["font family", qFam, "not found"]
@@ -790,10 +800,10 @@ isWireless = T.isPrefixOf "wl"
 isEthernet :: T.Text -> Bool
 isEthernet = T.isPrefixOf "en"
 
-listInterfaces :: IO [T.Text]
+listInterfaces :: MonadUnliftIO m => m [T.Text]
 listInterfaces =
   fromRight []
-    <$> tryIOError (fmap T.pack <$> listDirectory sysfsNet)
+    <$> tryIO (fmap T.pack <$> listDirectory sysfsNet)
 
 sysfsNet :: FilePath
 sysfsNet = "/sys/class/net"
@@ -816,19 +826,18 @@ readInterface n f = IORead n [] go
 --------------------------------------------------------------------------------
 -- Misc testers
 
-socketExists :: T.Text -> [Fulfillment] -> IO FilePath -> IODependency_
+socketExists :: T.Text -> [Fulfillment] -> FIO FilePath -> IODependency_
 socketExists n ful =
-  IOTest_ (T.unwords ["test if", n, "socket exists"]) ful
-    . io
-    . socketExists'
+  IOTest_ (T.unwords ["test if", n, "socket exists"]) ful . socketExists'
 
-socketExists' :: IO FilePath -> IO (Maybe Msg)
+socketExists' :: MonadUnliftIO m => m FilePath -> m (Maybe Msg)
 socketExists' getPath = do
   p <- getPath
-  r <- tryIOError $ getFileStatus p
+  r <- tryIO $ liftIO $ getFileStatus p
   return $ case r of
     Left e -> toErr $ T.pack $ ioe_description e
-    Right s -> if isSocket s then Nothing else toErr $ T.append (T.pack p) " is not a socket"
+    Right s | isSocket s -> Nothing
+    _ -> toErr $ T.append (T.pack p) " is not a socket"
   where
     toErr = Just . Msg LevelError
 
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 7efebab..8e7f583 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -46,9 +46,9 @@ import RIO
 import RIO.FilePath
 import qualified RIO.Process as P
 import qualified RIO.Text as T
-import System.Directory
 import System.Environment
 import System.Posix.User
+import UnliftIO.Directory
 import XMonad.Actions.Volume
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.DBus.Common
@@ -136,7 +136,7 @@ runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
     c = "exec tmux attach-session -d"
     msg = "could not connect to tmux session"
     socketName = do
-      u <- getEffectiveUserID
+      u <- liftIO getEffectiveUserID
       t <- getTemporaryDirectory
       return $ t </> "tmux-" ++ show u </> "default"
 
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index a26ac1f..f6b77ec 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -34,8 +34,8 @@ import RIO
 import RIO.FilePath
 import qualified RIO.Process as P
 import qualified RIO.Text as T
-import System.Directory
 import System.IO.Error
+import UnliftIO.Directory
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme as XT
diff --git a/package.yaml b/package.yaml
index e299e06..80ac40b 100644
--- a/package.yaml
+++ b/package.yaml
@@ -43,6 +43,7 @@ dependencies:
   - utf8-string >= 1.0.2
   - typed-process >= 0.2.8.0
   - network >= 3.1.2.7
+  - unliftio >= 0.2.21.0
 
 library:
   source-dirs: lib/

From 4b06ee125be58dcba6fd62a9b76b651aed8656fb Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 19:16:44 -0500
Subject: [PATCH 045/118] ENH generalize desktop and power

---
 lib/XMonad/Internal/Command/Desktop.hs |  4 ++--
 lib/XMonad/Internal/Command/Power.hs   | 19 ++++++++++---------
 2 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 8e7f583..7961564 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -46,9 +46,9 @@ import RIO
 import RIO.FilePath
 import qualified RIO.Process as P
 import qualified RIO.Text as T
-import System.Environment
 import System.Posix.User
 import UnliftIO.Directory
+import UnliftIO.Environment
 import XMonad.Actions.Volume
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.DBus.Common
@@ -334,7 +334,7 @@ runRecompile = do
 --------------------------------------------------------------------------------
 -- Screen capture commands
 
-getCaptureDir :: IO FilePath
+getCaptureDir :: MonadIO m => m FilePath
 getCaptureDir = do
   e <- lookupEnv "XDG_DATA_HOME"
   parent <- case e of
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index f6b77ec..2796bef 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -26,15 +26,13 @@ module XMonad.Internal.Command.Power
   )
 where
 
-import Data.Either
 import Data.Internal.Dependency
-import qualified Data.Map as M
 import Graphics.X11.Types
 import RIO
 import RIO.FilePath
+import qualified RIO.Map as M
 import qualified RIO.Process as P
 import qualified RIO.Text as T
-import System.IO.Error
 import UnliftIO.Directory
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.Shell
@@ -129,16 +127,19 @@ runQuitPrompt = sometimesPrompt "quit prompt" quitPrompt
 -- TODO for some reason the screen never wakes up after suspend when
 -- the nvidia card is up, so block suspend if nvidia card is running
 -- and warn user
-isUsingNvidia :: IO Bool
+isUsingNvidia :: MonadUnliftIO m => m Bool
 isUsingNvidia = doesDirectoryExist "/sys/module/nvidia"
 
-hasBattery :: IO (Maybe T.Text)
+hasBattery :: MonadUnliftIO m => m (Maybe T.Text)
 hasBattery = do
-  ps <- fromRight [] <$> tryIOError (listDirectory syspath)
-  ts <- mapM readType ps
-  return $ if "Battery\n" `elem` ts then Nothing else Just "battery not found"
+  ps <- fromRight [] <$> tryIO (listDirectory syspath)
+  ts <- catMaybes <$> mapM readType ps
+  return $
+    if any (T.isPrefixOf "Battery") ts
+      then Nothing
+      else Just "battery not found"
   where
-    readType p = fromRight [] <$> tryIOError (readFile $ syspath </> p </> "type")
+    readType p = either (const Nothing) Just <$> tryIO (readFileUtf8 $ syspath </> p </> "type")
     syspath = "/sys/class/power_supply"
 
 runOptimusPrompt' :: XT.FontBuilder -> X ()

From f1ced0c7e8449e7389f4ec4b494fcb602603cfac Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 19:47:02 -0500
Subject: [PATCH 046/118] REF remove lots of unused deps

---
 bin/xmobar.hs                                    |  4 +---
 bin/xmonad.hs                                    |  6 ++----
 lib/Data/Internal/DBus.hs                        |  5 +----
 lib/Data/Internal/Dependency.hs                  |  8 +-------
 lib/XMonad/Internal/Command/DMenu.hs             |  4 ++--
 lib/XMonad/Internal/Command/Desktop.hs           |  4 ++--
 lib/XMonad/Internal/Command/Power.hs             |  2 +-
 .../Internal/Concurrent/DynamicWorkspaces.hs     |  8 ++------
 lib/XMonad/Internal/DBus/Removable.hs            |  6 +++---
 lib/Xmobar/Plugins/Bluetooth.hs                  | 16 +++++++---------
 lib/Xmobar/Plugins/Device.hs                     |  1 -
 lib/Xmobar/Plugins/VPN.hs                        |  5 ++---
 package.yaml                                     |  9 ---------
 13 files changed, 24 insertions(+), 54 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index f2621a5..bf756a0 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -11,13 +11,11 @@
 -- * A custom Locks plugin from my own forked repo
 module Main (main) where
 
-import Control.Monad
 import Data.Internal.DBus
 import Data.Internal.Dependency
-import Data.List
-import Data.Maybe
 import RIO hiding (hFlush)
 import qualified RIO.ByteString.Lazy as BL
+import RIO.List
 import RIO.Process
 import qualified RIO.Text as T
 import System.Environment
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 5bd7d16..b9a525a 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -8,11 +8,8 @@
 
 module Main (main) where
 
-import Control.Monad
 import Data.Internal.DBus
 import Data.Internal.Dependency
-import Data.List
-import Data.Maybe
 import Data.Monoid
 import Data.Text.IO (hPutStrLn)
 import Graphics.X11.Types
@@ -20,14 +17,15 @@ import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Extras
 import RIO
 import RIO.Directory
+import RIO.List
 import RIO.Process
 import qualified RIO.Text as T
-import System.Environment
 import System.Posix.Signals
 import System.Process
   ( getPid
   , getProcessExitCode
   )
+import UnliftIO.Environment
 import XMonad
 import XMonad.Actions.CopyWindow
 import XMonad.Actions.CycleWS
diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 16fcc7b..8326bd5 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -28,13 +28,10 @@ module Data.Internal.DBus
   )
 where
 
-import Control.Monad
 import DBus
 import DBus.Client
-import Data.Bifunctor
-import qualified Data.Map.Strict as M
-import Data.Maybe
 import RIO
+import qualified RIO.Map as M
 import qualified RIO.Text as T
 
 --------------------------------------------------------------------------------
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index cf104d8..e63b623 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -99,23 +99,17 @@ module Data.Internal.Dependency
   )
 where
 
-import Control.Monad.IO.Class
-import Control.Monad.Identity
-import Control.Monad.Reader
 import DBus hiding (typeOf)
 import qualified DBus.Introspection as I
 import Data.Aeson hiding (Error, Result)
 import Data.Aeson.Key
-import Data.Bifunctor
-import Data.Either
 import Data.Internal.DBus
-import Data.List
-import Data.Maybe
 import Data.Yaml
 import GHC.IO.Exception (ioe_description)
 import RIO hiding (bracket, fromString)
 import RIO.Directory
 import RIO.FilePath
+import RIO.List
 import RIO.Process hiding (findExecutable)
 import qualified RIO.Text as T
 import System.Posix.Files
diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index d4333bd..710d15c 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -22,11 +22,11 @@ import DBus
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import Graphics.X11.Types
-import qualified RIO.Text as T
-import System.Directory
+import RIO.Directory
   ( XdgDirectory (..)
   , getXdgDirectory
   )
+import qualified RIO.Text as T
 import System.IO
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.Command.Desktop
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 7961564..d678eb0 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -43,11 +43,11 @@ import DBus
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import RIO
+import RIO.Directory
 import RIO.FilePath
 import qualified RIO.Process as P
 import qualified RIO.Text as T
 import System.Posix.User
-import UnliftIO.Directory
 import UnliftIO.Environment
 import XMonad.Actions.Volume
 import XMonad.Core hiding (spawn)
@@ -376,5 +376,5 @@ runCaptureBrowser = sometimesIO_
   "feh"
   (Only_ $ sysExe [Package Official "feh"] myImageBrowser)
   $ do
-    dir <- io getCaptureDir
+    dir <- getCaptureDir
     spawnCmd myImageBrowser [T.pack dir]
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index 2796bef..70b9c12 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -29,11 +29,11 @@ where
 import Data.Internal.Dependency
 import Graphics.X11.Types
 import RIO
+import RIO.Directory
 import RIO.FilePath
 import qualified RIO.Map as M
 import qualified RIO.Process as P
 import qualified RIO.Text as T
-import UnliftIO.Directory
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme as XT
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index d5e1c13..843db73 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -34,12 +34,6 @@ module XMonad.Internal.Concurrent.DynamicWorkspaces
   )
 where
 
--- import           Control.Concurrent
-import Control.Monad
-import Control.Monad.Reader
-import Data.List (deleteBy, find)
-import qualified Data.Map as M
-import Data.Maybe
 import Graphics.X11.Types
 import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Display
@@ -51,6 +45,8 @@ import RIO hiding
   ( Display
   , display
   )
+import RIO.List (deleteBy, find)
+import qualified RIO.Map as M
 import qualified RIO.Set as S
 import System.Process
 import XMonad.Actions.DynamicWorkspaces
diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs
index 87c0766..e338f05 100644
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@@ -8,12 +8,12 @@
 
 module XMonad.Internal.DBus.Removable (runRemovableMon) where
 
-import Control.Monad
 import DBus
 import DBus.Client
 import Data.Internal.DBus
 import Data.Internal.Dependency
-import Data.Map.Strict (Map, member)
+import RIO
+import qualified RIO.Map as M
 import XMonad.Core (io)
 import XMonad.Internal.Command.Desktop
 
@@ -61,7 +61,7 @@ addedHasDrive :: [Variant] -> Bool
 addedHasDrive [_, a] =
   maybe
     False
-    (member driveFlag)
+    (M.member driveFlag)
     (fromVariant a :: Maybe (Map String (Map String Variant)))
 addedHasDrive _ = False
 
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 12e8298..9886c32 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -39,16 +39,14 @@ module Xmobar.Plugins.Bluetooth
   )
 where
 
-import Control.Monad
 import DBus
 import DBus.Client
 import Data.Internal.DBus
 import Data.Internal.Dependency
-import Data.List
-import Data.List.Split
-import qualified Data.Map as M
-import Data.Maybe
 import RIO
+import RIO.FilePath
+import RIO.List
+import qualified RIO.Map as M
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Common
 import Xmobar
@@ -159,12 +157,12 @@ findDevices :: ObjectPath -> ObjectTree -> [ObjectPath]
 findDevices adapter = filter (adaptorHasDevice adapter) . M.keys
 
 adaptorHasDevice :: ObjectPath -> ObjectPath -> Bool
-adaptorHasDevice adaptor device = case splitPath device of
-  [org, bluez, hciX, _] -> splitPath adaptor == [org, bluez, hciX]
+adaptorHasDevice adaptor device = case splitPathNoRoot device of
+  [org, bluez, hciX, _] -> splitPathNoRoot adaptor == [org, bluez, hciX]
   _ -> False
 
-splitPath :: ObjectPath -> [T.Text]
-splitPath = fmap T.pack . splitOn "/" . dropWhile (== '/') . formatObjectPath
+splitPathNoRoot :: ObjectPath -> [FilePath]
+splitPathNoRoot = dropWhile (== "/") . splitDirectories . formatObjectPath
 
 getBtObjectTree :: MonadUnliftIO m => SysClient -> m ObjectTree
 getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index 1c309ae..9cc7ba1 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -15,7 +15,6 @@ where
 import DBus
 import Data.Internal.DBus
 import Data.Internal.Dependency
-import Data.Word
 import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.Command.Desktop
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index 309938e..e4be4d5 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -17,10 +17,9 @@ where
 import DBus
 import Data.Internal.DBus
 import Data.Internal.Dependency
-import qualified Data.Map as M
-import Data.Maybe
-import qualified Data.Set as S
 import RIO
+import qualified RIO.Map as M
+import qualified RIO.Set as S
 import qualified RIO.Text as T
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
diff --git a/package.yaml b/package.yaml
index 80ac40b..67888d1 100644
--- a/package.yaml
+++ b/package.yaml
@@ -19,27 +19,18 @@ dependencies:
   - base
   - bytestring >= 0.10.8.2
   - colour >= 2.3.5
-  - containers >= 0.6.0.1
   - dbus >= 1.2.7
   - fdo-notify
-  - io-streams >= 1.5.1.0
-  - mtl >= 2.2.2
   - unix >= 2.7.2.2
-  - tcp-streams >= 1.0.1.1
   - text >= 1.2.3.1
-  - directory >= 1.3.3.0
   - process >= 1.6.5.0
-  - split >= 0.2.3.4
   - xmobar
   - xmonad-extras >= 0.15.2
   - xmonad >= 0.13
   - xmonad-contrib >= 0.13
   - aeson >= 2.0.3.0
   - yaml >=0.11.8.0
-  - unordered-containers >= 0.2.16.0
-  - hashable >= 1.3.5.0
   - xml >= 1.3.14
-  - lifted-base >= 0.2.3.12
   - utf8-string >= 1.0.2
   - typed-process >= 0.2.8.0
   - network >= 3.1.2.7

From b52b22c48dde4e4fb7b7a0cc5a9478d2f641334a Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 19:48:09 -0500
Subject: [PATCH 047/118] ENH use unliftio

---
 bin/vbox-start.hs | 2 +-
 bin/xmobar.hs     | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/bin/vbox-start.hs b/bin/vbox-start.hs
index 57aecf2..3ba0228 100644
--- a/bin/vbox-start.hs
+++ b/bin/vbox-start.hs
@@ -20,9 +20,9 @@ import qualified Data.ByteString.Lazy.UTF8 as BU
 import RIO
 import RIO.Process
 import qualified RIO.Text as T
-import System.Environment
 import System.Process (Pid)
 import Text.XML.Light
+import UnliftIO.Environment
 import XMonad.Internal.Concurrent.VirtualBox
 import XMonad.Internal.IO
 
diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index bf756a0..c43bcc2 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -18,8 +18,8 @@ import qualified RIO.ByteString.Lazy as BL
 import RIO.List
 import RIO.Process
 import qualified RIO.Text as T
-import System.Environment
 import System.IO
+import UnliftIO.Environment
 import XMonad.Core hiding (config)
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.Command.Power

From c94d83f41e785c12d08c23a75b71daa540f9cd8c Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 19:50:32 -0500
Subject: [PATCH 048/118] REF use bracket

---
 lib/Data/Internal/DBus.hs | 8 ++------
 1 file changed, 2 insertions(+), 6 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 8326bd5..f895196 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -46,12 +46,8 @@ class SafeClient c where
   disconnectDBusClient = liftIO . disconnect . toClient
 
   withDBusClient :: MonadUnliftIO m => (c -> m a) -> m (Maybe a)
-  withDBusClient f = do
-    client <- getDBusClient
-    forM client $ \c -> do
-      r <- f c
-      liftIO $ disconnect (toClient c)
-      return r
+  withDBusClient f =
+    bracket getDBusClient (mapM (liftIO . disconnect . toClient)) $ mapM f
 
   withDBusClient_ :: MonadUnliftIO m => (c -> m ()) -> m ()
   withDBusClient_ = void . withDBusClient

From 7821140dc2603c54b675390342013c295409e95b Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 20:19:09 -0500
Subject: [PATCH 049/118] ENH use logging in dbus connect

---
 lib/XMonad/Internal/Concurrent/ClientMessage.hs   | 10 +---------
 .../Internal/Concurrent/DynamicWorkspaces.hs      |  3 ---
 lib/XMonad/Internal/DBus/Screensaver.hs           | 15 ++++++---------
 lib/XMonad/Internal/IO.hs                         | 13 ++++++++++++-
 4 files changed, 19 insertions(+), 22 deletions(-)

diff --git a/lib/XMonad/Internal/Concurrent/ClientMessage.hs b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
index 37e85c9..f8c0308 100644
--- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs
+++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
@@ -28,8 +28,7 @@ import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Display
 import Graphics.X11.Xlib.Event
 import Graphics.X11.Xlib.Extras
-import Graphics.X11.Xlib.Types
-import RIO hiding (Display)
+import XMonad.Internal.IO
 
 --------------------------------------------------------------------------------
 -- Data structure for the ClientMessage
@@ -64,13 +63,6 @@ splitXMsg (x : xs) = (xtype, tag)
     xtype = toEnum $ fromIntegral x
     tag = chr . fromIntegral <$> takeWhile (/= 0) xs
 
-withOpenDisplay :: (Display -> IO a) -> IO a
-withOpenDisplay = bracket (openDisplay "") cleanup
-  where
-    cleanup dpy = do
-      flush dpy
-      closeDisplay dpy
-
 -- | Emit a ClientMessage event to the X server with the given type and payloud
 sendXMsg :: XMsgType -> String -> IO ()
 sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index 843db73..6a64909 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -96,9 +96,6 @@ data WConf = WConf
 
 type W a = RIO WConf ()
 
-withOpenDisplay :: (Display -> IO a) -> IO a
-withOpenDisplay = bracket (openDisplay "") closeDisplay
-
 runWorkspaceMon :: [DynWorkspace] -> IO ()
 runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
   root <- rootWindow dpy $ defaultScreen dpy
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index a38a7f2..46ea1ca 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -18,9 +18,9 @@ import qualified DBus.Introspection as I
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import Graphics.X11.XScreenSaver
-import Graphics.X11.Xlib.Display
 import RIO
 import XMonad.Internal.DBus.Common
+import XMonad.Internal.IO
 import XMonad.Internal.Shell
 
 --------------------------------------------------------------------------------
@@ -31,7 +31,7 @@ type SSState = Bool -- true is enabled
 ssExecutable :: FilePath
 ssExecutable = "xset"
 
-toggle :: IO SSState
+toggle :: MonadUnliftIO m => m SSState
 toggle = do
   st <- query
   let args = if st then ["off", "-dpms"] else ["on", "+dpms"]
@@ -40,12 +40,9 @@ toggle = do
   rc <- runProcess (proc ssExecutable $ "s" : args)
   return $ if rc == ExitSuccess then not st else st
 
-query :: IO SSState
+query :: MonadUnliftIO m => m SSState
 query = do
-  -- TODO bracket the display
-  dpy <- openDisplay ""
-  xssi <- xScreenSaverQueryInfo dpy
-  closeDisplay dpy
+  xssi <- withOpenDisplay (liftIO . xScreenSaverQueryInfo)
   return $ case xssi of
     Just XScreenSaverInfo {xssi_state = ScreenSaverDisabled} -> False
     Just XScreenSaverInfo {xssi_state = _} -> True
@@ -101,7 +98,7 @@ exportScreensaver ses =
   where
     cmd cl =
       let cl' = toClient cl
-       in liftIO $
+       in withRunInIO $ \run ->
             export
               cl'
               ssPath
@@ -109,7 +106,7 @@ exportScreensaver ses =
                 { interfaceName = interface
                 , interfaceMethods =
                     [ autoMethod memToggle $ emitState cl' =<< toggle
-                    , autoMethod memQuery query
+                    , autoMethod memQuery (run query)
                     ]
                 , interfaceSignals = [sig]
                 }
diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs
index 6023619..2acde87 100644
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@@ -22,11 +22,15 @@ module XMonad.Internal.IO
   , PermResult (..)
   , getPermissionsSafe
   , waitUntilExit
+  , withOpenDisplay
   )
 where
 
 import Data.Char
-import RIO
+import Graphics.X11.Xlib.Display
+import Graphics.X11.Xlib.Event
+import Graphics.X11.Xlib.Types
+import RIO hiding (Display)
 import RIO.Directory
 import RIO.FilePath
 import qualified RIO.Text as T
@@ -168,3 +172,10 @@ waitUntilExit pid = do
   when res $ do
     threadDelay 100000
     waitUntilExit pid
+
+withOpenDisplay :: MonadUnliftIO m => (Display -> m a) -> m a
+withOpenDisplay = bracket (liftIO $ openDisplay "") cleanup
+  where
+    cleanup dpy = liftIO $ do
+      flush dpy
+      closeDisplay dpy

From 39bd464ca1e5cc8e7231eedf3caf9a643882bac8 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 20:23:27 -0500
Subject: [PATCH 050/118] ENH generalize screensaver

---
 lib/XMonad/Internal/DBus/Screensaver.hs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 46ea1ca..59cda53 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -82,8 +82,9 @@ ruleCurrentState =
     , matchMember = Just memState
     }
 
-emitState :: Client -> SSState -> IO ()
-emitState client sss = emit client $ sigCurrentState {signalBody = [toVariant sss]}
+emitState :: MonadUnliftIO m => Client -> SSState -> m ()
+emitState client sss =
+  liftIO $ emit client $ sigCurrentState {signalBody = [toVariant sss]}
 
 bodyGetCurrentState :: [Variant] -> Maybe SSState
 bodyGetCurrentState [b] = fromVariant b :: Maybe SSState
@@ -105,7 +106,7 @@ exportScreensaver ses =
               defaultInterface
                 { interfaceName = interface
                 , interfaceMethods =
-                    [ autoMethod memToggle $ emitState cl' =<< toggle
+                    [ autoMethod memToggle $ run $ emitState cl' =<< toggle
                     , autoMethod memQuery (run query)
                     ]
                 , interfaceSignals = [sig]
@@ -134,12 +135,12 @@ callToggle =
     interface
     memToggle
 
-callQuery :: SesClient -> IO (Maybe SSState)
+callQuery :: MonadUnliftIO m => SesClient -> m (Maybe SSState)
 callQuery ses = do
   reply <- callMethod ses xmonadBusName ssPath interface memQuery
   return $ either (const Nothing) bodyGetCurrentState reply
 
-matchSignal :: (Maybe SSState -> IO ()) -> SesClient -> IO ()
+matchSignal :: MonadUnliftIO m => (Maybe SSState -> m ()) -> SesClient -> m ()
 matchSignal cb ses =
   void $
     addMatchCallback

From f6c05967160584083d911ff7599e672300b8ecbf Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 22:22:36 -0500
Subject: [PATCH 051/118] ENH use rio for xmobar plugins

---
 lib/Xmobar/Plugins/BacklightCommon.hs | 4 ++--
 lib/Xmobar/Plugins/Common.hs          | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs
index 2fd17b0..7605953 100644
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@@ -13,8 +13,8 @@ import Xmobar.Plugins.Common
 
 startBacklight
   :: (MonadUnliftIO m, RealFrac a)
-  => ((Maybe a -> m ()) -> SesClient -> m ())
-  -> (SesClient -> m (Maybe a))
+  => ((Maybe a -> RIO SimpleApp ()) -> SesClient -> RIO SimpleApp ())
+  -> (SesClient -> RIO SimpleApp (Maybe a))
   -> T.Text
   -> Callback
   -> m ()
diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs
index 98b9acc..1983bba 100644
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@@ -70,6 +70,6 @@ displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na)
 withDBusClientConnection
   :: (MonadUnliftIO m, SafeClient c)
   => Callback
-  -> (c -> m ())
+  -> (c -> RIO SimpleApp ())
   -> m ()
-withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient
+withDBusClientConnection cb f = runSimpleApp $ displayMaybe' cb f =<< getDBusClient

From a997cac7a38874ea9ae74040062bd6baf87eb7ef Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 22:24:20 -0500
Subject: [PATCH 052/118] ENH run all of xmobar in rio

---
 bin/xmobar.hs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index c43bcc2..45c6c5e 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -50,13 +50,14 @@ parse ["--test"] = void $ withCache . evalConfig =<< connectDBus
 parse _ = usage
 
 run :: IO ()
-run = do
+run = withCache $ do
   db <- connectDBus
-  c <- withCache $ evalConfig db
+  c <- evalConfig db
   disconnectDBus db
-  -- this is needed to see any printed messages
-  hFlush stdout
-  xmobar c
+  liftIO $ do
+    -- this is needed to see any printed messages
+    hFlush stdout
+    xmobar c
 
 evalConfig :: DBusState -> FIO Config
 evalConfig db = do

From 3b8c6b0f4f64bcad5c90f8e5d80b27ae797f765b Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 22:31:23 -0500
Subject: [PATCH 053/118] ENH use dbus bracket for xmobar

---
 bin/xmobar.hs                       | 4 +---
 lib/XMonad/Internal/DBus/Control.hs | 8 ++++++++
 2 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 45c6c5e..936a01c 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -50,10 +50,8 @@ parse ["--test"] = void $ withCache . evalConfig =<< connectDBus
 parse _ = usage
 
 run :: IO ()
-run = withCache $ do
-  db <- connectDBus
+run = withCache $ withDBus_ $ \db -> do
   c <- evalConfig db
-  disconnectDBus db
   liftIO $ do
     -- this is needed to see any printed messages
     hFlush stdout
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 0f43ac4..ac4f892 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -6,6 +6,8 @@
 module XMonad.Internal.DBus.Control
   ( Client
   , DBusState (..)
+  , withDBus
+  , withDBus_
   , connectDBus
   , connectDBusX
   , disconnectDBus
@@ -34,6 +36,12 @@ data DBusState = DBusState
   , dbSysClient :: Maybe SysClient
   }
 
+withDBus_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
+withDBus_ = void . withDBus
+
+withDBus :: MonadUnliftIO m => (DBusState -> m a) -> m a
+withDBus = bracket connectDBus disconnectDBus
+
 -- | Connect to the DBus
 connectDBus :: MonadUnliftIO m => m DBusState
 connectDBus = do

From 8c20a4668d812aeb7834003301e3c8379c6f0f69 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 22:33:33 -0500
Subject: [PATCH 054/118] ENH use bracket dbus for xmobar tests

---
 bin/xmobar.hs | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 936a01c..026d474 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -46,7 +46,7 @@ main = getArgs >>= parse
 parse :: [String] -> IO ()
 parse [] = run
 parse ["--deps"] = withCache printDeps
-parse ["--test"] = void $ withCache . evalConfig =<< connectDBus
+parse ["--test"] = withCache $ withDBus_ evalConfig
 parse _ = usage
 
 run :: IO ()
@@ -66,11 +66,13 @@ evalConfig db = do
   return $ config bf ifs ios cs d
 
 printDeps :: FIO ()
-printDeps = do
-  db <- io connectDBus
-  let ps = sort $ nub $ fmap showFulfillment $ concatMap dumpFeature $ allFeatures db
-  io $ mapM_ (putStrLn . T.unpack) ps
-  io $ disconnectDBus db
+printDeps = withDBus_ $ \db ->
+  mapM_ (liftIO . putStrLn . T.unpack) $
+    sort $
+      nub $
+        fmap showFulfillment $
+          concatMap dumpFeature $
+            allFeatures db
 
 usage :: IO ()
 usage =

From 4951c2a35ed46c2d3b8ed0231e62e471228f2d20 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 22:47:36 -0500
Subject: [PATCH 055/118] ENH use bracket for request/release busname

---
 bin/xmonad.hs                       | 14 +++++++-------
 lib/XMonad/Internal/DBus/Control.hs | 10 ++++++++++
 2 files changed, 17 insertions(+), 7 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index b9a525a..5c06402 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -89,7 +89,7 @@ run = do
   uninstallSignalHandlers
   hSetBuffering stdout LineBuffering
   withCache $ do
-    withDBusX $ \db -> do
+    withDBusX_ $ \db -> do
       let sys = dbSysClient db
       let fs = features sys
       startDBusInterfaces db fs
@@ -204,12 +204,12 @@ startXmobar = do
 startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
 
-withDBusX :: (DBusState -> FIO a) -> FIO a
-withDBusX = bracket (io connectDBusX) cleanup
-  where
-    cleanup db = do
-      logInfo "unregistering xmonad from DBus"
-      io $ disconnectDBus db
+-- withDBusX :: (DBusState -> FIO a) -> FIO a
+-- withDBusX = bracket (io connectDBusX) cleanup
+--   where
+--     cleanup db = do
+--       logInfo "unregistering xmonad from DBus"
+--       io $ disconnectDBus db
 
 withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
 withChildDaemons fs = bracket (startChildDaemons fs) cleanup
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index ac4f892..0013fa7 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -6,6 +6,8 @@
 module XMonad.Internal.DBus.Control
   ( Client
   , DBusState (..)
+  , withDBusX
+  , withDBusX_
   , withDBus
   , withDBus_
   , connectDBus
@@ -36,6 +38,14 @@ data DBusState = DBusState
   , dbSysClient :: Maybe SysClient
   }
 
+withDBusX_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
+withDBusX_ = void . withDBusX
+
+withDBusX :: MonadUnliftIO m => (DBusState -> m a) -> m (Maybe a)
+withDBusX f = withDBus $ \db -> do
+  forM (dbSesClient db) $ \ses -> do
+    bracket_ (requestXMonadName ses) (releaseXMonadName ses) $ f db
+
 withDBus_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
 withDBus_ = void . withDBus
 

From 05f1165cc11db77cdf256183aba8aa5b87133345 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 22:49:46 -0500
Subject: [PATCH 056/118] REF a bitty thingy

---
 bin/xmonad.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 5c06402..add49b6 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -90,8 +90,7 @@ run = do
   hSetBuffering stdout LineBuffering
   withCache $ do
     withDBusX_ $ \db -> do
-      let sys = dbSysClient db
-      let fs = features sys
+      let fs = features $ dbSysClient db
       startDBusInterfaces db fs
       withXmobar $ \xmobarP -> do
         withChildDaemons fs $ \ds -> do

From fcb454bc292ec6e05395ce58328948eb2def5de9 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 22:55:32 -0500
Subject: [PATCH 057/118] ENH use dbus bracket with xmonad dep print

---
 bin/xmonad.hs                       | 24 +++++++-----------------
 lib/XMonad/Internal/DBus/Control.hs | 20 +++++++++++++++++---
 2 files changed, 24 insertions(+), 20 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index add49b6..1f7eb21 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -203,13 +203,6 @@ startXmobar = do
 startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
 
--- withDBusX :: (DBusState -> FIO a) -> FIO a
--- withDBusX = bracket (io connectDBusX) cleanup
---   where
---     cleanup db = do
---       logInfo "unregistering xmonad from DBus"
---       io $ disconnectDBus db
-
 withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
 withChildDaemons fs = bracket (startChildDaemons fs) cleanup
   where
@@ -225,17 +218,14 @@ withXmobar = bracket startXmobar cleanup
       io $ killNoWait p
 
 printDeps :: FIO ()
-printDeps = do
-  db <- io connectDBus
+printDeps = withDBus_ $ \db -> do
   (i, f, d) <- allFeatures db
-  io $
-    mapM_ (putStrLn . T.unpack) $
-      fmap showFulfillment $
-        sort $
-          nub $
-            concat $
-              fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
-  io $ disconnectDBus db
+  mapM_ (liftIO . putStrLn . T.unpack) $
+    fmap showFulfillment $
+      sort $
+        nub $
+          concat $
+            fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
 
 allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
 allFeatures db = do
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 0013fa7..4369b2f 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 --------------------------------------------------------------------------------
@@ -38,13 +39,26 @@ data DBusState = DBusState
   , dbSysClient :: Maybe SysClient
   }
 
-withDBusX_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
+withDBusX_
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => (DBusState -> m a)
+  -> m ()
 withDBusX_ = void . withDBusX
 
-withDBusX :: MonadUnliftIO m => (DBusState -> m a) -> m (Maybe a)
+withDBusX
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => (DBusState -> m a)
+  -> m (Maybe a)
 withDBusX f = withDBus $ \db -> do
   forM (dbSesClient db) $ \ses -> do
-    bracket_ (requestXMonadName ses) (releaseXMonadName ses) $ f db
+    bracket_ (up ses) (down ses) $ f db
+  where
+    up cl = do
+      logInfo "registering xmonad to DBus"
+      requestXMonadName cl
+    down cl = do
+      logInfo "unregistering xmonad from DBus"
+      releaseXMonadName cl
 
 withDBus_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
 withDBus_ = void . withDBus

From 8a217d08eb8076e13cc6d17f380ab9530383679f Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 23:02:50 -0500
Subject: [PATCH 058/118] ENH don't use putstrln for errors on dbus startup

---
 lib/Data/Internal/DBus.hs           | 28 ++++++++++++++++++++++------
 lib/XMonad/Internal/DBus/Control.hs | 18 ++++++++++++++----
 2 files changed, 36 insertions(+), 10 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index f895196..888bd39 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -40,19 +40,30 @@ import qualified RIO.Text as T
 class SafeClient c where
   toClient :: c -> Client
 
-  getDBusClient :: MonadUnliftIO m => m (Maybe c)
+  getDBusClient
+    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+    => m (Maybe c)
 
   disconnectDBusClient :: MonadUnliftIO m => c -> m ()
   disconnectDBusClient = liftIO . disconnect . toClient
 
-  withDBusClient :: MonadUnliftIO m => (c -> m a) -> m (Maybe a)
+  withDBusClient
+    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+    => (c -> m a)
+    -> m (Maybe a)
   withDBusClient f =
     bracket getDBusClient (mapM (liftIO . disconnect . toClient)) $ mapM f
 
-  withDBusClient_ :: MonadUnliftIO m => (c -> m ()) -> m ()
+  withDBusClient_
+    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+    => (c -> m ())
+    -> m ()
   withDBusClient_ = void . withDBusClient
 
-  fromDBusClient :: MonadUnliftIO m => (c -> a) -> m (Maybe a)
+  fromDBusClient
+    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+    => (c -> a)
+    -> m (Maybe a)
   fromDBusClient f = withDBusClient (return . f)
 
 newtype SysClient = SysClient Client
@@ -69,11 +80,16 @@ instance SafeClient SesClient where
 
   getDBusClient = fmap SesClient <$> getDBusClient' False
 
-getDBusClient' :: MonadUnliftIO m => Bool -> m (Maybe Client)
+getDBusClient'
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => Bool
+  -> m (Maybe Client)
 getDBusClient' sys = do
   res <- try $ liftIO $ if sys then connectSystem else connectSession
   case res of
-    Left e -> liftIO $ putStrLn (clientErrorMessage e) >> return Nothing
+    Left e -> do
+      logInfo $ Utf8Builder $ encodeUtf8Builder $ T.pack $ clientErrorMessage e
+      return Nothing
     Right c -> return $ Just c
 
 --------------------------------------------------------------------------------
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 4369b2f..e490c38 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -60,14 +60,22 @@ withDBusX f = withDBus $ \db -> do
       logInfo "unregistering xmonad from DBus"
       releaseXMonadName cl
 
-withDBus_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
+withDBus_
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => (DBusState -> m a)
+  -> m ()
 withDBus_ = void . withDBus
 
-withDBus :: MonadUnliftIO m => (DBusState -> m a) -> m a
+withDBus
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => (DBusState -> m a)
+  -> m a
 withDBus = bracket connectDBus disconnectDBus
 
 -- | Connect to the DBus
-connectDBus :: MonadUnliftIO m => m DBusState
+connectDBus
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => m DBusState
 connectDBus = do
   ses <- getDBusClient
   sys <- getDBusClient
@@ -80,7 +88,9 @@ disconnectDBus db = disc dbSesClient >> disc dbSysClient
     disc f = maybe (return ()) disconnectDBusClient $ f db
 
 -- | Connect to the DBus and request the XMonad name
-connectDBusX :: MonadUnliftIO m => m DBusState
+connectDBusX
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => m DBusState
 connectDBusX = do
   db <- connectDBus
   forM_ (dbSesClient db) requestXMonadName

From 745a548baff6f2958317db3084ee1e1ea2f2656b Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 23:18:41 -0500
Subject: [PATCH 059/118] ENH enable line buffering in xmobar

---
 bin/xmobar.hs | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 026d474..f15b839 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -18,7 +18,6 @@ import qualified RIO.ByteString.Lazy as BL
 import RIO.List
 import RIO.Process
 import qualified RIO.Text as T
-import System.IO
 import UnliftIO.Environment
 import XMonad.Core hiding (config)
 import XMonad.Internal.Command.Desktop
@@ -50,12 +49,12 @@ parse ["--test"] = withCache $ withDBus_ evalConfig
 parse _ = usage
 
 run :: IO ()
-run = withCache $ withDBus_ $ \db -> do
-  c <- evalConfig db
-  liftIO $ do
-    -- this is needed to see any printed messages
-    hFlush stdout
-    xmobar c
+run = do
+  -- IDK why this is needed, I thought this was default
+  hSetBuffering stdout LineBuffering
+  withCache $ withDBus_ $ \db -> do
+    c <- evalConfig db
+    liftIO $ xmobar c
 
 evalConfig :: DBusState -> FIO Config
 evalConfig db = do

From 4206893967d7d30abea20b0e632968f875d3cd91 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 23:33:06 -0500
Subject: [PATCH 060/118] ENH log dbus name registration in function

---
 bin/xmonad.hs                       | 10 ++-------
 lib/XMonad/Internal/DBus/Control.hs | 32 ++++++++++++++---------------
 2 files changed, 18 insertions(+), 24 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 1f7eb21..267dc02 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -95,8 +95,8 @@ run = do
       withXmobar $ \xmobarP -> do
         withChildDaemons fs $ \ds -> do
           let ts = ThreadState ds (Just xmobarP)
-          startRemovableMon db fs
-          startPowerMon fs
+          void $ executeSometimes $ fsRemovableMon fs $ dbSysClient db
+          void $ async $ void $ executeSometimes $ fsPowerMon fs
           dws <- startDynWorkspaces fs
           kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
           sk <- evalAlways $ fsShowKeys fs
@@ -122,12 +122,6 @@ run = do
                         }
           io $ runXMonad conf
   where
-    startRemovableMon db fs =
-      void $
-        executeSometimes $
-          fsRemovableMon fs $
-            dbSysClient db
-    startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
     startDynWorkspaces fs = do
       dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
       void $ io $ async $ runWorkspaceMon dws
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index e490c38..1799442 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -28,6 +28,7 @@ import DBus.Client
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import RIO
+import qualified RIO.Text as T
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import XMonad.Internal.DBus.Brightness.IntelBacklight
 import XMonad.Internal.DBus.Common
@@ -51,14 +52,7 @@ withDBusX
   -> m (Maybe a)
 withDBusX f = withDBus $ \db -> do
   forM (dbSesClient db) $ \ses -> do
-    bracket_ (up ses) (down ses) $ f db
-  where
-    up cl = do
-      logInfo "registering xmonad to DBus"
-      requestXMonadName cl
-    down cl = do
-      logInfo "unregistering xmonad from DBus"
-      releaseXMonadName cl
+    bracket_ (requestXMonadName ses) (releaseXMonadName ses) $ f db
 
 withDBus_
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
@@ -109,17 +103,23 @@ dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 releaseXMonadName :: MonadUnliftIO m => SesClient -> m ()
 releaseXMonadName ses = liftIO $ void $ releaseName (toClient ses) xmonadBusName
 
-requestXMonadName :: MonadUnliftIO m => SesClient -> m ()
+requestXMonadName
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SesClient
+  -> m ()
 requestXMonadName ses = do
   res <- liftIO $ requestName (toClient ses) xmonadBusName []
-  -- TODO if the client is not released on shutdown the owner will be different
   let msg
-        | res == NamePrimaryOwner = Nothing
-        | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
+        | res == NamePrimaryOwner = "registering name"
+        | res == NameAlreadyOwner = "this process already owns name"
         | res == NameInQueue
             || res == NameExists =
-            Just $ "another process owns " ++ xn
-        | otherwise = Just $ "unknown error when requesting " ++ xn
-  liftIO $ forM_ msg putStrLn
+            "another process owns name"
+        | otherwise = "unknown error when requesting name"
+  logInfo $ msg <> ": " <> xn
   where
-    xn = "'" ++ formatBusName xmonadBusName ++ "'"
+    xn =
+      Utf8Builder $
+        encodeUtf8Builder $
+          T.pack $
+            formatBusName xmonadBusName

From 609048f6b614ac3c28b3b09c912529c7dec00805 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 23:56:23 -0500
Subject: [PATCH 061/118] ENH use logger in disconnect

---
 bin/xmonad.hs                       | 29 +++++++++++++++++++----------
 lib/XMonad/Internal/DBus/Control.hs | 15 ++++++++++++---
 2 files changed, 31 insertions(+), 13 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 267dc02..5841249 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 
 --------------------------------------------------------------------------------
 --  XMonad binary
@@ -98,7 +99,9 @@ run = do
           void $ executeSometimes $ fsRemovableMon fs $ dbSysClient db
           void $ async $ void $ executeSometimes $ fsPowerMon fs
           dws <- startDynWorkspaces fs
-          kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
+          runIO <- askRunInIO
+          let cleanup = runCleanup runIO ts db
+          kbs <- filterExternal <$> evalExternal (fsKeys fs cleanup ts db)
           sk <- evalAlways $ fsShowKeys fs
           ha <- evalAlways $ fsACPIHandler fs
           tt <- evalAlways $ fsTabbedTheme fs
@@ -151,7 +154,7 @@ getCreateDirectories = do
         _ -> return ()
 
 data FeatureSet = FeatureSet
-  { fsKeys :: ThreadState -> DBusState -> [KeyGroup FeatureX]
+  { fsKeys :: X () -> ThreadState -> DBusState -> [KeyGroup FeatureX]
   , fsDBusExporters :: [Maybe SesClient -> SometimesIO]
   , fsPowerMon :: SometimesIO
   , fsRemovableMon :: Maybe SysClient -> SometimesIO
@@ -222,10 +225,11 @@ printDeps = withDBus_ $ \db -> do
             fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
 
 allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
-allFeatures db = do
+allFeatures db = withRunInIO $ \runIO -> do
+  let cleanup = runCleanup runIO ts db
   let bfs =
         concatMap (fmap kbMaybeAction . kgBindings) $
-          externalBindings ts db
+          externalBindings cleanup ts db
   let dbus = fmap (\f -> f $ dbSesClient db) dbusExporters
   let others = [runRemovableMon $ dbSysClient db, runPowermon]
   return (dbus ++ others, Left runScreenLock : bfs, allDWs')
@@ -249,11 +253,16 @@ data ThreadState = ThreadState
   , tsXmobar :: Maybe (Process Handle () ())
   }
 
-runCleanup :: ThreadState -> DBusState -> X ()
-runCleanup ts db = io $ do
+runCleanup
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => (m () -> IO ())
+  -> ThreadState
+  -> DBusState
+  -> X ()
+runCleanup runIO ts db = io $ do
   mapM_ killNoWait $ tsXmobar ts
   mapM_ killNoWait $ tsChildPIDs ts
-  disconnectDBusX db
+  liftIO $ runIO $ disconnectDBusX db
 
 -- | Kill a process (group) after xmonad has already started
 -- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad
@@ -739,8 +748,8 @@ filterExternal = fmap go
             ]
         }
 
-externalBindings :: ThreadState -> DBusState -> [KeyGroup FeatureX]
-externalBindings ts db =
+externalBindings :: X () -> ThreadState -> DBusState -> [KeyGroup FeatureX]
+externalBindings cleanup _ db =
   [ KeyGroup
       "Launchers"
       [ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu
@@ -816,7 +825,7 @@ externalBindings ts db =
     ib = Left . brightessControls intelBacklightControls
     ck = Left . brightessControls clevoKeyboardControls
     ftrAlways n = Right . Always n . Always_ . FallbackAlone
-    restartf = ftrAlways "restart function" (runCleanup ts db >> runRestart)
+    restartf = ftrAlways "restart function" (cleanup >> runRestart)
     recompilef = ftrAlways "recompile function" runRecompile
 
 type MaybeX = Maybe (X ())
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 1799442..50c2baa 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -91,7 +91,10 @@ connectDBusX = do
   return db
 
 -- | Disconnect from DBus and release the XMonad name
-disconnectDBusX :: MonadUnliftIO m => DBusState -> m ()
+disconnectDBusX
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => DBusState
+  -> m ()
 disconnectDBusX db = do
   forM_ (dbSesClient db) releaseXMonadName
   disconnectDBus db
@@ -100,8 +103,14 @@ disconnectDBusX db = do
 dbusExporters :: [Maybe SesClient -> SometimesIO]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 
-releaseXMonadName :: MonadUnliftIO m => SesClient -> m ()
-releaseXMonadName ses = liftIO $ void $ releaseName (toClient ses) xmonadBusName
+releaseXMonadName
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SesClient
+  -> m ()
+releaseXMonadName ses = do
+  -- TODO this might error?
+  liftIO $ void $ releaseName (toClient ses) xmonadBusName
+  logInfo "released xmonad name"
 
 requestXMonadName
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)

From f875b7c71d2d1ffb033f59b954f4327d5a306cc4 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 00:01:06 -0500
Subject: [PATCH 062/118] REF remove extra theadstate

---
 bin/xmonad.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 5841249..ca7e33a 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -101,7 +101,7 @@ run = do
           dws <- startDynWorkspaces fs
           runIO <- askRunInIO
           let cleanup = runCleanup runIO ts db
-          kbs <- filterExternal <$> evalExternal (fsKeys fs cleanup ts db)
+          kbs <- filterExternal <$> evalExternal (fsKeys fs cleanup db)
           sk <- evalAlways $ fsShowKeys fs
           ha <- evalAlways $ fsACPIHandler fs
           tt <- evalAlways $ fsTabbedTheme fs
@@ -154,7 +154,7 @@ getCreateDirectories = do
         _ -> return ()
 
 data FeatureSet = FeatureSet
-  { fsKeys :: X () -> ThreadState -> DBusState -> [KeyGroup FeatureX]
+  { fsKeys :: X () -> DBusState -> [KeyGroup FeatureX]
   , fsDBusExporters :: [Maybe SesClient -> SometimesIO]
   , fsPowerMon :: SometimesIO
   , fsRemovableMon :: Maybe SysClient -> SometimesIO
@@ -229,7 +229,7 @@ allFeatures db = withRunInIO $ \runIO -> do
   let cleanup = runCleanup runIO ts db
   let bfs =
         concatMap (fmap kbMaybeAction . kgBindings) $
-          externalBindings cleanup ts db
+          externalBindings cleanup db
   let dbus = fmap (\f -> f $ dbSesClient db) dbusExporters
   let others = [runRemovableMon $ dbSysClient db, runPowermon]
   return (dbus ++ others, Left runScreenLock : bfs, allDWs')
@@ -748,8 +748,8 @@ filterExternal = fmap go
             ]
         }
 
-externalBindings :: X () -> ThreadState -> DBusState -> [KeyGroup FeatureX]
-externalBindings cleanup _ db =
+externalBindings :: X () -> DBusState -> [KeyGroup FeatureX]
+externalBindings cleanup db =
   [ KeyGroup
       "Launchers"
       [ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu

From 91ff25a8d208376e6caad4375b6a56ba8c577b83 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 11:14:58 -0500
Subject: [PATCH 063/118] ENH don't use putstrln for printing packages

---
 bin/xmobar.hs                   | 8 ++++----
 bin/xmonad.hs                   | 2 +-
 lib/Data/Internal/Dependency.hs | 5 +++--
 3 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index f15b839..e81af0d 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -66,10 +66,10 @@ evalConfig db = do
 
 printDeps :: FIO ()
 printDeps = withDBus_ $ \db ->
-  mapM_ (liftIO . putStrLn . T.unpack) $
-    sort $
-      nub $
-        fmap showFulfillment $
+  mapM_ logInfo $
+    fmap showFulfillment $
+      sort $
+        nub $
           concatMap dumpFeature $
             allFeatures db
 
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index ca7e33a..6af3f15 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -217,7 +217,7 @@ withXmobar = bracket startXmobar cleanup
 printDeps :: FIO ()
 printDeps = withDBus_ $ \db -> do
   (i, f, d) <- allFeatures db
-  mapM_ (liftIO . putStrLn . T.unpack) $
+  mapM_ logInfo $
     fmap showFulfillment $
       sort $
         nub $
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index e63b623..a28f84d 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -186,8 +186,9 @@ logMsg (FMsg fn n (Msg ll m)) = do
 --------------------------------------------------------------------------------
 -- Package status
 
-showFulfillment :: Fulfillment -> T.Text
-showFulfillment (Package t n) = T.concat [T.pack $ show t, "\t", n]
+showFulfillment :: Fulfillment -> Utf8Builder
+showFulfillment (Package t n) =
+  displayShow t <> "\t" <> Utf8Builder (encodeUtf8Builder n)
 
 dumpFeature :: Feature a -> [Fulfillment]
 dumpFeature = either dumpSometimes dumpAlways

From 0e1b11763920683e8357bae72f48df563d552322 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 11:20:15 -0500
Subject: [PATCH 064/118] REF add comment

---
 bin/xmonad.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 6af3f15..14fa0d1 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -217,6 +217,7 @@ withXmobar = bracket startXmobar cleanup
 printDeps :: FIO ()
 printDeps = withDBus_ $ \db -> do
   (i, f, d) <- allFeatures db
+  -- TODO might be better to use glog for this?
   mapM_ logInfo $
     fmap showFulfillment $
       sort $

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 065/118] 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/

From b3f07ba590def8f150789f044446ded2591c9bbd Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 11:44:36 -0500
Subject: [PATCH 066/118] ENH use optparse for xmobar

---
 bin/xmobar.hs | 52 ++++++++++++++++++++++++++++++++-------------------
 1 file changed, 33 insertions(+), 19 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index e81af0d..e7fa370 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -13,12 +13,12 @@ module Main (main) where
 
 import Data.Internal.DBus
 import Data.Internal.Dependency
+import Options.Applicative
 import RIO hiding (hFlush)
 import qualified RIO.ByteString.Lazy as BL
 import RIO.List
 import RIO.Process
 import qualified RIO.Text as T
-import UnliftIO.Environment
 import XMonad.Core hiding (config)
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.Command.Power
@@ -40,19 +40,42 @@ import Xmobar.Plugins.Screensaver
 import Xmobar.Plugins.VPN
 
 main :: IO ()
-main = getArgs >>= parse
+main = parse >>= xio
 
-parse :: [String] -> IO ()
-parse [] = run
-parse ["--deps"] = withCache printDeps
-parse ["--test"] = withCache $ withDBus_ evalConfig
-parse _ = usage
+parse :: IO XOpts
+parse = execParser opts
+  where
+    parseOpts = parseDeps <|> parseTest <|> pure XRun
+    opts =
+      info (parseOpts <**> helper) $
+        fullDesc <> header "xmobar: the best taskbar 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 -> withDBus_ evalConfig
+    XRun -> run
+
+run :: FIO ()
 run = do
   -- IDK why this is needed, I thought this was default
-  hSetBuffering stdout LineBuffering
-  withCache $ withDBus_ $ \db -> do
+  liftIO $ hSetBuffering stdout LineBuffering
+  withDBus_ $ \db -> do
     c <- evalConfig db
     liftIO $ xmobar c
 
@@ -73,15 +96,6 @@ printDeps = withDBus_ $ \db ->
           concatMap dumpFeature $
             allFeatures db
 
-usage :: IO ()
-usage =
-  putStrLn $
-    intercalate
-      "\n"
-      [ "xmobar: run greatest taskbar"
-      , "xmobar --deps: print dependencies"
-      ]
-
 --------------------------------------------------------------------------------
 -- toplevel configuration
 

From 335fa7b460a400890e1a926da0c9977918e33f1b Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 11:46:33 -0500
Subject: [PATCH 067/118] ENH use logger for usage in vbox script

---
 bin/vbox-start.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/bin/vbox-start.hs b/bin/vbox-start.hs
index 3ba0228..b911726 100644
--- a/bin/vbox-start.hs
+++ b/bin/vbox-start.hs
@@ -43,7 +43,7 @@ runAndWait [n] = do
       p <- vmPID i
       liftIO $ mapM_ waitUntilExit p
     err = logError "Could not get machine ID"
-runAndWait _ = liftIO $ putStrLn "Usage: vbox-start VBOXNAME"
+runAndWait _ = logInfo "Usage: vbox-start VBOXNAME"
 
 vmLaunch :: T.Text -> RIO SimpleApp ()
 vmLaunch i = do

From 89eacd63aa040398255ca72825bf0ed573f54351 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 11:50:17 -0500
Subject: [PATCH 068/118] ENH use rio logger for eventhook

---
 bin/xmonad.hs | 24 +++++++++++++++++-------
 1 file changed, 17 insertions(+), 7 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 5a3c4d3..b23c2e1 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -136,7 +136,7 @@ run = do
                       , modMask = myModMask
                       , layoutHook = myLayouts tt
                       , manageHook = myManageHook dws
-                      , handleEventHook = myEventHook ha
+                      , handleEventHook = myEventHook runIO ha
                       , startupHook = myStartupHook
                       , workspaces = myWorkspaces
                       , logHook = myLoghook xmobarP
@@ -625,20 +625,30 @@ manageApps dws =
 --------------------------------------------------------------------------------
 -- Eventhook configuration
 
-myEventHook :: (String -> X ()) -> Event -> X All
-myEventHook handler = xMsgEventHook handler <+> handleEventHook def
+myEventHook
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => (m () -> IO ())
+  -> (String -> X ())
+  -> Event
+  -> X All
+myEventHook runIO handler = xMsgEventHook runIO handler <+> handleEventHook def
 
 -- | React to ClientMessage events from concurrent threads
-xMsgEventHook :: (String -> X ()) -> Event -> X All
-xMsgEventHook handler ClientMessageEvent {ev_message_type = t, ev_data = d}
+xMsgEventHook
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => (m () -> IO ())
+  -> (String -> X ())
+  -> Event
+  -> X All
+xMsgEventHook runIO handler ClientMessageEvent {ev_message_type = t, ev_data = d}
   | t == bITMAP = do
       let (xtype, tag) = splitXMsg d
       case xtype of
         Workspace -> removeDynamicWorkspace tag
         ACPI -> handler tag
-        Unknown -> io $ putStrLn "WARNING: unknown concurrent message"
+        Unknown -> liftIO $ runIO $ logWarn "unknown concurrent message"
       return (All True)
-xMsgEventHook _ _ = return (All True)
+xMsgEventHook _ _ _ = return (All True)
 
 --------------------------------------------------------------------------------
 -- Keymap configuration

From 4afaf9af104b086d777faae6994b37f842759866 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 12:07:43 -0500
Subject: [PATCH 069/118] ENH log cleanup for xmobar and child processes

---
 bin/xmonad.hs             | 42 +++++++++++++++++++++++----------------
 lib/XMonad/Internal/IO.hs |  2 +-
 2 files changed, 26 insertions(+), 18 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index b23c2e1..1ee95a2 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -208,6 +208,9 @@ features cl =
     , fsDaemons = [runNetAppDaemon cl, runAutolock]
     }
 
+withXmobar :: (Process Handle () () -> FIO a) -> FIO a
+withXmobar = bracket startXmobar stopXmobar
+
 startXmobar :: FIO (Process Handle () ())
 startXmobar = do
   p <- proc "xmobar" [] start
@@ -219,22 +222,27 @@ startXmobar = do
         . setStdin createPipe
         . setCreateGroup True
 
+stopXmobar
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => Process Handle () ()
+  -> m ()
+stopXmobar p = do
+  logInfo "stopping xmobar child process"
+  io $ killNoWait p
+
+withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
+withChildDaemons fs = bracket (startChildDaemons fs) stopChildDaemons
+
 startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
 
-withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
-withChildDaemons fs = bracket (startChildDaemons fs) cleanup
-  where
-    cleanup ps = do
-      logInfo "stopping child processes"
-      mapM_ (io . killNoWait) ps
-
-withXmobar :: (Process Handle () () -> FIO a) -> FIO a
-withXmobar = bracket startXmobar cleanup
-  where
-    cleanup p = do
-      logInfo "stopping xmobar child process"
-      io $ killNoWait p
+stopChildDaemons
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => [Process () () ()]
+  -> m ()
+stopChildDaemons ps = do
+  logInfo "stopping child processes"
+  mapM_ (liftIO . killNoWait) ps
 
 printDeps :: FIO ()
 printDeps = withDBus_ $ \db -> do
@@ -273,10 +281,10 @@ runCleanup
   -> ThreadState
   -> DBusState
   -> X ()
-runCleanup runIO ts db = io $ do
-  mapM_ killNoWait $ tsXmobar ts
-  mapM_ killNoWait $ tsChildPIDs ts
-  liftIO $ runIO $ disconnectDBusX db
+runCleanup runIO ts db = liftIO $ runIO $ do
+  mapM_ stopXmobar $ tsXmobar ts
+  stopChildDaemons $ tsChildPIDs ts
+  disconnectDBusX db
 
 -- | Kill a process (group) after xmonad has already started
 -- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad
diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs
index 2acde87..4e3a712 100644
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@@ -166,7 +166,7 @@ getPermissionsSafe f = do
 -- | Block until a PID has exited.
 -- Use this to control flow based on a process that was not explicitly started
 -- by the Haskell runtime itself, and thus has no data structures to query.
-waitUntilExit :: (MonadIO m) => Pid -> m ()
+waitUntilExit :: (MonadUnliftIO m) => Pid -> m ()
 waitUntilExit pid = do
   res <- doesDirectoryExist $ "/proc" </> show pid
   when res $ do

From 43345f8ce02a365013b1aceb50025b67b9e69667 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 12:43:54 -0500
Subject: [PATCH 070/118] ENH use exporter/unexporter pairs

---
 bin/xmonad.hs                                 | 86 ++++++++++---------
 .../Internal/DBus/Brightness/ClevoKeyboard.hs |  2 +-
 lib/XMonad/Internal/DBus/Brightness/Common.hs | 52 +++++------
 .../DBus/Brightness/IntelBacklight.hs         |  2 +-
 lib/XMonad/Internal/DBus/Control.hs           | 11 ++-
 lib/XMonad/Internal/DBus/Screensaver.hs       |  9 +-
 6 files changed, 89 insertions(+), 73 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 1ee95a2..9234c21 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -114,38 +114,39 @@ run = do
   hSetBuffering stdout LineBuffering
   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 runIO 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
+    -- startDBusInterfaces db fs
+    withDBusInterfaces db $ \_ -> do
+      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 runIO 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)
@@ -157,10 +158,8 @@ runXMonad conf = do
   dirs <- getCreateDirectories
   launch conf dirs
 
-startDBusInterfaces :: DBusState -> FeatureSet -> FIO ()
-startDBusInterfaces db fs =
-  mapM_ (\f -> executeSometimes $ f $ dbSesClient db) $
-    fsDBusExporters fs
+-- startDBusInterfaces :: DBusState -> [Maybe SesClient -> SometimesIO] -> FIO ()
+-- startDBusInterfaces db = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
 
 getCreateDirectories :: IO Directories
 getCreateDirectories = do
@@ -177,7 +176,7 @@ getCreateDirectories = do
 
 data FeatureSet = FeatureSet
   { fsKeys :: X () -> DBusState -> [KeyGroup FeatureX]
-  , fsDBusExporters :: [Maybe SesClient -> SometimesIO]
+  , fsDBusExporters :: [Maybe SesClient -> Sometimes (IO (), IO ())]
   , fsPowerMon :: SometimesIO
   , fsRemovableMon :: Maybe SysClient -> SometimesIO
   , fsDaemons :: [Sometimes (FIO (Process () () ()))]
@@ -246,16 +245,21 @@ stopChildDaemons ps = do
 
 printDeps :: FIO ()
 printDeps = withDBus_ $ \db -> do
-  (i, f, d) <- allFeatures db
+  (u, i, f, d) <- allFeatures db
   -- TODO might be better to use glog for this?
   mapM_ logInfo $
     fmap showFulfillment $
       sort $
         nub $
           concat $
-            fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
+            fmap dumpSometimes u
+              ++ fmap dumpFeature f
+              ++ fmap dumpSometimes i
+              ++ fmap dumpSometimes d
 
-allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
+allFeatures
+  :: DBusState
+  -> FIO ([Sometimes (IO (), IO ())], [SometimesIO], [FeatureX], [Sometimes DynWorkspace])
 allFeatures db = withRunInIO $ \runIO -> do
   let cleanup = runCleanup runIO ts db
   let bfs =
@@ -263,7 +267,7 @@ allFeatures db = withRunInIO $ \runIO -> do
           externalBindings cleanup db
   let dbus = fmap (\f -> f $ dbSesClient db) dbusExporters
   let others = [runRemovableMon $ dbSysClient db, runPowermon]
-  return (dbus ++ others, Left runScreenLock : bfs, allDWs')
+  return (dbus, others, Left runScreenLock : bfs, allDWs')
   where
     ts = ThreadState {tsChildPIDs = [], tsXmobar = Nothing}
 
diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
index 8352949..75bd291 100644
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@@ -115,7 +115,7 @@ brightnessFileDep = pathR brightnessFile [Package AUR "tuxedo-keyboard"]
 clevoKeyboardSignalDep :: DBusDependency_ SesClient
 clevoKeyboardSignalDep = signalDep clevoKeyboardConfig
 
-exportClevoKeyboard :: Maybe SesClient -> SometimesIO
+exportClevoKeyboard :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m (), m ())
 exportClevoKeyboard =
   brightnessExporter
     xpfClevoBacklight
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 7f336f4..29d844f 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -101,45 +101,47 @@ matchSignal BrightnessConfig {bcPath = p, bcInterface = i} cb =
 -- Internal DBus Crap
 
 brightnessExporter
-  :: RealFrac b
+  :: (MonadUnliftIO m, RealFrac b)
   => XPQuery
   -> [Fulfillment]
   -> [IODependency_]
   -> BrightnessConfig a b
   -> Maybe SesClient
-  -> SometimesIO
+  -> Sometimes (m (), m ())
 brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
   Sometimes (T.append n " DBus Interface") q [Subfeature root "exporter"]
   where
-    root = DBusRoot_ (exportBrightnessControls' bc) tree cl
+    root = DBusRoot_ (exportBrightnessControlsInner bc) tree cl
     tree = listToAnds (Bus ful xmonadBusName) $ fmap DBusIO deps
 
-exportBrightnessControls'
+exportBrightnessControlsInner
   :: (MonadUnliftIO m, RealFrac b)
   => BrightnessConfig a b
   -> SesClient
-  -> m ()
-exportBrightnessControls' bc cl = io $ do
-  let ses = toClient cl
-  maxval <- bcGetMax bc -- assume the max value will never change
-  let bounds = (bcMinRaw bc, maxval)
-  let autoMethod' m f = autoMethod m $ emitBrightness bc ses =<< f bc bounds
-  let funget = bcGet bc
-  export
-    ses
-    (bcPath bc)
-    defaultInterface
-      { interfaceName = bcInterface bc
-      , interfaceMethods =
-          [ autoMethod' memMax bcMax
-          , autoMethod' memMin bcMin
-          , autoMethod' memInc bcInc
-          , autoMethod' memDec bcDec
-          , autoMethod memGet (round <$> funget bounds :: IO Int32)
-          ]
-      , interfaceSignals = [sig]
-      }
+  -> (m (), m ())
+exportBrightnessControlsInner bc cl = (up, down)
   where
+    up = liftIO $ do
+      let ses = toClient cl
+      maxval <- bcGetMax bc -- assume the max value will never change
+      let bounds = (bcMinRaw bc, maxval)
+      let autoMethod' m f = autoMethod m $ emitBrightness bc ses =<< f bc bounds
+      let funget = bcGet bc
+      export
+        ses
+        (bcPath bc)
+        defaultInterface
+          { interfaceName = bcInterface bc
+          , interfaceMethods =
+              [ autoMethod' memMax bcMax
+              , autoMethod' memMin bcMin
+              , autoMethod' memInc bcInc
+              , autoMethod' memDec bcDec
+              , autoMethod memGet (round <$> funget bounds :: IO Int32)
+              ]
+          , interfaceSignals = [sig]
+          }
+    down = liftIO $ unexport (toClient cl) (bcPath bc)
     sig =
       I.Signal
         { I.signalName = memCur
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index 0858fed..53dbdcd 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@@ -99,7 +99,7 @@ maxFileDep = pathR maxFile []
 intelBacklightSignalDep :: DBusDependency_ SesClient
 intelBacklightSignalDep = signalDep intelBacklightConfig
 
-exportIntelBacklight :: Maybe SesClient -> SometimesIO
+exportIntelBacklight :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m (), m ())
 exportIntelBacklight =
   brightnessExporter
     xpfIntelBacklight
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 50c2baa..4c7791b 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -7,6 +7,7 @@
 module XMonad.Internal.DBus.Control
   ( Client
   , DBusState (..)
+  , withDBusInterfaces
   , withDBusX
   , withDBusX_
   , withDBus
@@ -99,8 +100,16 @@ disconnectDBusX db = do
   forM_ (dbSesClient db) releaseXMonadName
   disconnectDBus db
 
+withDBusInterfaces :: DBusState -> ([FIO ()] -> FIO a) -> FIO a
+withDBusInterfaces db = bracket up sequence
+  where
+    up = do
+      pairs <- catMaybes <$> mapM (\f -> evalSometimes $ f $ dbSesClient db) dbusExporters
+      mapM_ fst pairs
+      return $ snd <$> pairs
+
 -- | All exporter features to be assigned to the DBus
-dbusExporters :: [Maybe SesClient -> SometimesIO]
+dbusExporters :: MonadUnliftIO m => [Maybe SesClient -> Sometimes (m (), m ())]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 
 releaseXMonadName
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 59cda53..cfd20ce 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -93,13 +93,13 @@ bodyGetCurrentState _ = Nothing
 --------------------------------------------------------------------------------
 -- Exported haskell API
 
-exportScreensaver :: Maybe SesClient -> SometimesIO
+exportScreensaver :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m (), m ())
 exportScreensaver ses =
-  sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) cmd
+  sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) $ \cl -> (up cl, down cl)
   where
-    cmd cl =
+    up cl =
       let cl' = toClient cl
-       in withRunInIO $ \run ->
+       in liftIO $ withRunInIO $ \run ->
             export
               cl'
               ssPath
@@ -111,6 +111,7 @@ exportScreensaver ses =
                     ]
                 , interfaceSignals = [sig]
                 }
+    down cl = liftIO $ unexport (toClient cl) ssPath
     sig =
       I.Signal
         { I.signalName = memState

From 2ef652ebe1dbb01d5bbbdf8ce2d4f5a784dfdc52 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 12:49:56 -0500
Subject: [PATCH 071/118] ENH don't hardcode interfaces

---
 bin/xmonad.hs                       |  8 ++------
 lib/XMonad/Internal/DBus/Control.hs | 10 +++++++---
 2 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 9234c21..834222c 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -114,8 +114,7 @@ run = do
   hSetBuffering stdout LineBuffering
   withDBusX_ $ \db -> do
     let fs = features $ dbSysClient db
-    -- startDBusInterfaces db fs
-    withDBusInterfaces db $ \_ -> do
+    withDBusInterfaces db (fsDBusExporters fs) $ \_ -> do
       withXmobar $ \xmobarP -> do
         withChildDaemons fs $ \ds -> do
           let ts = ThreadState ds (Just xmobarP)
@@ -158,9 +157,6 @@ runXMonad conf = do
   dirs <- getCreateDirectories
   launch conf dirs
 
--- startDBusInterfaces :: DBusState -> [Maybe SesClient -> SometimesIO] -> FIO ()
--- startDBusInterfaces db = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
-
 getCreateDirectories :: IO Directories
 getCreateDirectories = do
   ds <- getDirectories
@@ -176,7 +172,7 @@ getCreateDirectories = do
 
 data FeatureSet = FeatureSet
   { fsKeys :: X () -> DBusState -> [KeyGroup FeatureX]
-  , fsDBusExporters :: [Maybe SesClient -> Sometimes (IO (), IO ())]
+  , fsDBusExporters :: [Maybe SesClient -> Sometimes (FIO (), FIO ())]
   , fsPowerMon :: SometimesIO
   , fsRemovableMon :: Maybe SysClient -> SometimesIO
   , fsDaemons :: [Sometimes (FIO (Process () () ()))]
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 4c7791b..ea45fa9 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -100,11 +100,15 @@ disconnectDBusX db = do
   forM_ (dbSesClient db) releaseXMonadName
   disconnectDBus db
 
-withDBusInterfaces :: DBusState -> ([FIO ()] -> FIO a) -> FIO a
-withDBusInterfaces db = bracket up sequence
+withDBusInterfaces
+  :: DBusState
+  -> [Maybe SesClient -> Sometimes (FIO (), FIO ())]
+  -> ([FIO ()] -> FIO a)
+  -> FIO a
+withDBusInterfaces db interfaces = bracket up sequence
   where
     up = do
-      pairs <- catMaybes <$> mapM (\f -> evalSometimes $ f $ dbSesClient db) dbusExporters
+      pairs <- catMaybes <$> mapM (\f -> evalSometimes $ f $ dbSesClient db) interfaces
       mapM_ fst pairs
       return $ snd <$> pairs
 

From e0a186dd1897c0b691674daeb6df5e76b8b55c2f Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 13:07:10 -0500
Subject: [PATCH 072/118] ENH clean up interfaces

---
 bin/xmonad.hs                           | 55 ++++++++++++-------------
 lib/XMonad/Internal/DBus/Control.hs     |  4 +-
 lib/XMonad/Internal/DBus/Screensaver.hs |  9 +++-
 3 files changed, 36 insertions(+), 32 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 834222c..f7747db 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -114,15 +114,15 @@ run = do
   hSetBuffering stdout LineBuffering
   withDBusX_ $ \db -> do
     let fs = features $ dbSysClient db
-    withDBusInterfaces db (fsDBusExporters fs) $ \_ -> do
+    withDBusInterfaces db (fsDBusExporters fs) $ \unexporters -> do
       withXmobar $ \xmobarP -> do
         withChildDaemons fs $ \ds -> do
-          let ts = ThreadState ds (Just xmobarP)
+          let toClean = Cleanup ds (Just xmobarP) unexporters
           void $ executeSometimes $ fsRemovableMon fs $ dbSysClient db
           void $ async $ void $ executeSometimes $ fsPowerMon fs
           dws <- startDynWorkspaces fs
           runIO <- askRunInIO
-          let cleanup = runCleanup runIO ts db
+          let cleanup = runCleanup runIO toClean db
           kbs <- filterExternal <$> evalExternal (fsKeys fs cleanup db)
           sk <- evalAlways $ fsShowKeys fs
           ha <- evalAlways $ fsACPIHandler fs
@@ -241,49 +241,46 @@ stopChildDaemons ps = do
 
 printDeps :: FIO ()
 printDeps = withDBus_ $ \db -> do
-  (u, i, f, d) <- allFeatures db
+  runIO <- askRunInIO
+  let mockCleanup = runCleanup runIO mockClean db
+  let bfs =
+        concatMap (fmap kbMaybeAction . kgBindings) $
+          externalBindings mockCleanup db
+  let dbus =
+        fmap (\f -> f $ dbSesClient db) dbusExporters
+          :: [Sometimes (FIO (), FIO ())]
+  let others = [runRemovableMon $ dbSysClient db, runPowermon]
   -- TODO might be better to use glog for this?
   mapM_ logInfo $
     fmap showFulfillment $
       sort $
         nub $
           concat $
-            fmap dumpSometimes u
-              ++ fmap dumpFeature f
-              ++ fmap dumpSometimes i
-              ++ fmap dumpSometimes d
-
-allFeatures
-  :: DBusState
-  -> FIO ([Sometimes (IO (), IO ())], [SometimesIO], [FeatureX], [Sometimes DynWorkspace])
-allFeatures db = withRunInIO $ \runIO -> do
-  let cleanup = runCleanup runIO ts db
-  let bfs =
-        concatMap (fmap kbMaybeAction . kgBindings) $
-          externalBindings cleanup db
-  let dbus = fmap (\f -> f $ dbSesClient db) dbusExporters
-  let others = [runRemovableMon $ dbSysClient db, runPowermon]
-  return (dbus, others, Left runScreenLock : bfs, allDWs')
+            fmap dumpSometimes dbus
+              ++ fmap dumpSometimes others
+              ++ fmap dumpSometimes allDWs'
+              ++ fmap dumpFeature bfs
   where
-    ts = ThreadState {tsChildPIDs = [], tsXmobar = Nothing}
+    mockClean = Cleanup {clChildren = [], clXmobar = Nothing, clDBusUnexporters = []}
 
 --------------------------------------------------------------------------------
 -- Concurrency configuration
 
-data ThreadState = ThreadState
-  { tsChildPIDs :: [Process () () ()]
-  , tsXmobar :: Maybe (Process Handle () ())
+data Cleanup = Cleanup
+  { clChildren :: [Process () () ()]
+  , clXmobar :: Maybe (Process Handle () ())
+  , clDBusUnexporters :: [FIO ()]
   }
 
 runCleanup
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => (m () -> IO ())
-  -> ThreadState
+  :: (FIO () -> IO ())
+  -> Cleanup
   -> DBusState
   -> X ()
 runCleanup runIO ts db = liftIO $ runIO $ do
-  mapM_ stopXmobar $ tsXmobar ts
-  stopChildDaemons $ tsChildPIDs ts
+  mapM_ stopXmobar $ clXmobar ts
+  stopChildDaemons $ clChildren ts
+  sequence_ $ clDBusUnexporters ts
   disconnectDBusX db
 
 -- | Kill a process (group) after xmonad has already started
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index ea45fa9..584a618 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -113,7 +113,9 @@ withDBusInterfaces db interfaces = bracket up sequence
       return $ snd <$> pairs
 
 -- | All exporter features to be assigned to the DBus
-dbusExporters :: MonadUnliftIO m => [Maybe SesClient -> Sometimes (m (), m ())]
+dbusExporters
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => [Maybe SesClient -> Sometimes (m (), m ())]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 
 releaseXMonadName
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index cfd20ce..4cc6c4a 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -93,7 +93,10 @@ bodyGetCurrentState _ = Nothing
 --------------------------------------------------------------------------------
 -- Exported haskell API
 
-exportScreensaver :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m (), m ())
+exportScreensaver
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => Maybe SesClient
+  -> Sometimes (m (), m ())
 exportScreensaver ses =
   sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) $ \cl -> (up cl, down cl)
   where
@@ -111,7 +114,9 @@ exportScreensaver ses =
                     ]
                 , interfaceSignals = [sig]
                 }
-    down cl = liftIO $ unexport (toClient cl) ssPath
+    down cl = do
+      logInfo "removing screensaver interface"
+      liftIO $ unexport (toClient cl) ssPath
     sig =
       I.Signal
         { I.signalName = memState

From b2416153e6249ac769f65169463bfc0925a7b1b6 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 13:26:09 -0500
Subject: [PATCH 073/118] ENH standardize export/unexport pairs

---
 lib/Data/Internal/DBus.hs               | 24 ++++++++++++++++++++
 lib/XMonad/Internal/DBus/Screensaver.hs | 30 ++++++++++---------------
 2 files changed, 36 insertions(+), 18 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 888bd39..0fa93be 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Common internal DBus functions
 
@@ -25,6 +27,7 @@ module Data.Internal.DBus
   , addInterfaceRemovedListener
   , fromSingletonVariant
   , bodyToMaybe
+  , exportPair
   )
 where
 
@@ -302,3 +305,24 @@ addInterfaceRemovedListener
   -> m (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
   addInterfaceChangedListener bus omInterfacesRemoved
+
+--------------------------------------------------------------------------------
+-- Interface export/unexport
+
+exportPair
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
+  => ObjectPath
+  -> (Client -> m Interface)
+  -> c
+  -> (m (), m ())
+exportPair path toIface cl = (up, down)
+  where
+    cl_ = toClient cl
+    up = do
+      logInfo $ "adding interface: " <> path_
+      i <- toIface cl_
+      liftIO $ export cl_ path i
+    down = do
+      logInfo $ "removing interface: " <> path_
+      liftIO $ unexport cl_ path
+    path_ = Utf8Builder $ encodeUtf8Builder $ T.pack $ formatObjectPath path
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 4cc6c4a..8d385d6 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -98,25 +98,19 @@ exportScreensaver
   => Maybe SesClient
   -> Sometimes (m (), m ())
 exportScreensaver ses =
-  sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) $ \cl -> (up cl, down cl)
+  sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) cmd
   where
-    up cl =
-      let cl' = toClient cl
-       in liftIO $ withRunInIO $ \run ->
-            export
-              cl'
-              ssPath
-              defaultInterface
-                { interfaceName = interface
-                , interfaceMethods =
-                    [ autoMethod memToggle $ run $ emitState cl' =<< toggle
-                    , autoMethod memQuery (run query)
-                    ]
-                , interfaceSignals = [sig]
-                }
-    down cl = do
-      logInfo "removing screensaver interface"
-      liftIO $ unexport (toClient cl) ssPath
+    cmd = exportPair ssPath $ \cl_ -> do
+      liftIO $ withRunInIO $ \run ->
+        return $
+          defaultInterface
+            { interfaceName = interface
+            , interfaceMethods =
+                [ autoMethod memToggle $ run $ emitState cl_ =<< toggle
+                , autoMethod memQuery (run query)
+                ]
+            , interfaceSignals = [sig]
+            }
     sig =
       I.Signal
         { I.signalName = memState

From ac743daa32550891aa8ebefe8e24d979bbd42183 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 13:32:46 -0500
Subject: [PATCH 074/118] ENH use exporter/unexporter for all interfaces

---
 .../Internal/DBus/Brightness/ClevoKeyboard.hs |  5 +++-
 lib/XMonad/Internal/DBus/Brightness/Common.hs | 24 ++++++++++---------
 .../DBus/Brightness/IntelBacklight.hs         |  5 +++-
 3 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
index 75bd291..7ca50d1 100644
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@@ -115,7 +115,10 @@ brightnessFileDep = pathR brightnessFile [Package AUR "tuxedo-keyboard"]
 clevoKeyboardSignalDep :: DBusDependency_ SesClient
 clevoKeyboardSignalDep = signalDep clevoKeyboardConfig
 
-exportClevoKeyboard :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m (), m ())
+exportClevoKeyboard
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => Maybe SesClient
+  -> Sometimes (m (), m ())
 exportClevoKeyboard =
   brightnessExporter
     xpfClevoBacklight
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 29d844f..4c91b75 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -101,7 +101,7 @@ matchSignal BrightnessConfig {bcPath = p, bcInterface = i} cb =
 -- Internal DBus Crap
 
 brightnessExporter
-  :: (MonadUnliftIO m, RealFrac b)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, RealFrac b)
   => XPQuery
   -> [Fulfillment]
   -> [IODependency_]
@@ -115,21 +115,23 @@ brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
     tree = listToAnds (Bus ful xmonadBusName) $ fmap DBusIO deps
 
 exportBrightnessControlsInner
-  :: (MonadUnliftIO m, RealFrac b)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, RealFrac b)
   => BrightnessConfig a b
   -> SesClient
   -> (m (), m ())
-exportBrightnessControlsInner bc cl = (up, down)
+exportBrightnessControlsInner bc = cmd
   where
-    up = liftIO $ do
-      let ses = toClient cl
-      maxval <- bcGetMax bc -- assume the max value will never change
+    cmd = exportPair (bcPath bc) $ \cl_ -> do
+      -- up = liftIO $ do
+      -- let ses = toClient cl
+      maxval <- liftIO $ bcGetMax bc -- assume the max value will never change
       let bounds = (bcMinRaw bc, maxval)
-      let autoMethod' m f = autoMethod m $ emitBrightness bc ses =<< f bc bounds
+      let autoMethod' m f = autoMethod m $ emitBrightness bc cl_ =<< f bc bounds
       let funget = bcGet bc
-      export
-        ses
-        (bcPath bc)
+      -- export
+      --   ses
+      --   (bcPath bc)
+      return $
         defaultInterface
           { interfaceName = bcInterface bc
           , interfaceMethods =
@@ -141,7 +143,7 @@ exportBrightnessControlsInner bc cl = (up, down)
               ]
           , interfaceSignals = [sig]
           }
-    down = liftIO $ unexport (toClient cl) (bcPath bc)
+    -- down = liftIO $ unexport (toClient cl) (bcPath bc)
     sig =
       I.Signal
         { I.signalName = memCur
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index 53dbdcd..9b15321 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@@ -99,7 +99,10 @@ maxFileDep = pathR maxFile []
 intelBacklightSignalDep :: DBusDependency_ SesClient
 intelBacklightSignalDep = signalDep intelBacklightConfig
 
-exportIntelBacklight :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m (), m ())
+exportIntelBacklight
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => Maybe SesClient
+  -> Sometimes (m (), m ())
 exportIntelBacklight =
   brightnessExporter
     xpfIntelBacklight

From 00f899ed9a2ff9395ab038ab688398e22d9e2fd9 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 14:57:23 -0500
Subject: [PATCH 075/118] ENH be more precise when logging child processes

---
 bin/xmonad.hs | 33 +++++++++++++++++++++++++--------
 1 file changed, 25 insertions(+), 8 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index f7747db..7e7a4a4 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -208,6 +208,7 @@ withXmobar = bracket startXmobar stopXmobar
 
 startXmobar :: FIO (Process Handle () ())
 startXmobar = do
+  logInfo "starting xmobar child process"
   p <- proc "xmobar" [] start
   io $ hSetBuffering (getStdin p) LineBuffering
   return p
@@ -225,19 +226,35 @@ stopXmobar p = do
   logInfo "stopping xmobar child process"
   io $ killNoWait p
 
-withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
+withChildDaemons
+  :: FeatureSet
+  -> ([(Utf8Builder, Process () () ())] -> FIO a)
+  -> FIO a
 withChildDaemons fs = bracket (startChildDaemons fs) stopChildDaemons
 
-startChildDaemons :: FeatureSet -> FIO [Process () () ()]
-startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
+startChildDaemons :: FeatureSet -> FIO [(Utf8Builder, Process () () ())]
+startChildDaemons fs = catMaybes <$> mapM start (fsDaemons fs)
+  where
+    start s@(Sometimes sname _ _) = do
+      let sname_ = Utf8Builder $ encodeUtf8Builder sname
+      res <- executeSometimes s
+      case res of
+        Just p -> do
+          logInfo $ "starting child process: " <> sname_
+          return $ Just (sname_, p)
+        -- don't log anything here since presumably the feature itself will log
+        -- an error if it fails during execution
+        _ -> return Nothing
 
 stopChildDaemons
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => [Process () () ()]
+  => [(Utf8Builder, Process () () ())]
   -> m ()
-stopChildDaemons ps = do
-  logInfo "stopping child processes"
-  mapM_ (liftIO . killNoWait) ps
+stopChildDaemons = mapM_ stop
+  where
+    stop (n, p) = do
+      logInfo $ "stopping child process: " <> n
+      liftIO $ killNoWait p
 
 printDeps :: FIO ()
 printDeps = withDBus_ $ \db -> do
@@ -267,7 +284,7 @@ printDeps = withDBus_ $ \db -> do
 -- Concurrency configuration
 
 data Cleanup = Cleanup
-  { clChildren :: [Process () () ()]
+  { clChildren :: [(Utf8Builder, Process () () ())]
   , clXmobar :: Maybe (Process Handle () ())
   , clDBusUnexporters :: [FIO ()]
   }

From 6b3cfd58570f2bb2374518f1e21545f4b2c26364 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 15:00:40 -0500
Subject: [PATCH 076/118] REF use better naming for RIO monad

---
 bin/xmobar.hs                          | 16 +++---
 bin/xmonad.hs                          | 30 +++++------
 lib/Data/Internal/Dependency.hs        | 70 +++++++++++++-------------
 lib/XMonad/Internal/Command/Desktop.hs |  2 +-
 lib/XMonad/Internal/Command/Power.hs   |  2 +-
 lib/XMonad/Internal/DBus/Control.hs    |  6 +--
 6 files changed, 63 insertions(+), 63 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index e7fa370..fe6f300 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -65,13 +65,13 @@ parseTest =
     (long "test" <> short 't' <> help "test dependencies without running")
 
 xio :: XOpts -> IO ()
-xio o = withCache $
+xio o = runXIO $
   case o of
     XDeps -> printDeps
     XTest -> withDBus_ evalConfig
     XRun -> run
 
-run :: FIO ()
+run :: XIO ()
 run = do
   -- IDK why this is needed, I thought this was default
   liftIO $ hSetBuffering stdout LineBuffering
@@ -79,7 +79,7 @@ run = do
     c <- evalConfig db
     liftIO $ xmobar c
 
-evalConfig :: DBusState -> FIO Config
+evalConfig :: DBusState -> XIO Config
 evalConfig db = do
   cs <- getAllCommands <$> rightPlugins db
   bf <- getTextFont
@@ -87,7 +87,7 @@ evalConfig db = do
   d <- io $ cfgDir <$> getDirectories
   return $ config bf ifs ios cs d
 
-printDeps :: FIO ()
+printDeps :: XIO ()
 printDeps = withDBus_ $ \db ->
   mapM_ logInfo $
     fmap showFulfillment $
@@ -186,7 +186,7 @@ getAllCommands right =
     , brRight = catMaybes right
     }
 
-rightPlugins :: DBusState -> FIO [Maybe CmdSpec]
+rightPlugins :: DBusState -> XIO [Maybe CmdSpec]
 rightPlugins db =
   mapM evalFeature $
     allFeatures db
@@ -523,7 +523,7 @@ dateCmd =
 --------------------------------------------------------------------------------
 -- low-level testing functions
 
-vpnPresent :: FIO (Maybe Msg)
+vpnPresent :: XIO (Maybe Msg)
 vpnPresent = do
   res <- proc "nmcli" args readProcess
   return $ case res of
@@ -549,7 +549,7 @@ vpnPresent = do
 -- ASSUME there is only one text font for this entire configuration. This
 -- will correspond to the first font/offset parameters in the config record.
 
-getTextFont :: FIO T.Text
+getTextFont :: XIO T.Text
 getTextFont = do
   fb <- evalAlways textFont
   return $ fb textFontData
@@ -557,7 +557,7 @@ getTextFont = do
 --------------------------------------------------------------------------------
 -- icon fonts
 
-getIconFonts :: FIO ([T.Text], [Int])
+getIconFonts :: XIO ([T.Text], [Int])
 getIconFonts = do
   fb <- evalSometimes iconFont
   return $ maybe ([], []) apply fb
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 7e7a4a4..e1708bc 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -91,13 +91,13 @@ parseTest =
     (long "test" <> short 't' <> help "test dependencies without running")
 
 xio :: XOpts -> IO ()
-xio o = withCache $
+xio o = runXIO $
   case o of
     XDeps -> printDeps
     XTest -> undefined
     XRun -> run
 
-run :: FIO ()
+run :: XIO ()
 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
@@ -172,10 +172,10 @@ getCreateDirectories = do
 
 data FeatureSet = FeatureSet
   { fsKeys :: X () -> DBusState -> [KeyGroup FeatureX]
-  , fsDBusExporters :: [Maybe SesClient -> Sometimes (FIO (), FIO ())]
+  , fsDBusExporters :: [Maybe SesClient -> Sometimes (XIO (), XIO ())]
   , fsPowerMon :: SometimesIO
   , fsRemovableMon :: Maybe SysClient -> SometimesIO
-  , fsDaemons :: [Sometimes (FIO (Process () () ()))]
+  , fsDaemons :: [Sometimes (XIO (Process () () ()))]
   , fsACPIHandler :: Always (String -> X ())
   , fsTabbedTheme :: Always Theme
   , fsDynWorkspaces :: [Sometimes DynWorkspace]
@@ -203,10 +203,10 @@ features cl =
     , fsDaemons = [runNetAppDaemon cl, runAutolock]
     }
 
-withXmobar :: (Process Handle () () -> FIO a) -> FIO a
+withXmobar :: (Process Handle () () -> XIO a) -> XIO a
 withXmobar = bracket startXmobar stopXmobar
 
-startXmobar :: FIO (Process Handle () ())
+startXmobar :: XIO (Process Handle () ())
 startXmobar = do
   logInfo "starting xmobar child process"
   p <- proc "xmobar" [] start
@@ -228,11 +228,11 @@ stopXmobar p = do
 
 withChildDaemons
   :: FeatureSet
-  -> ([(Utf8Builder, Process () () ())] -> FIO a)
-  -> FIO a
+  -> ([(Utf8Builder, Process () () ())] -> XIO a)
+  -> XIO a
 withChildDaemons fs = bracket (startChildDaemons fs) stopChildDaemons
 
-startChildDaemons :: FeatureSet -> FIO [(Utf8Builder, Process () () ())]
+startChildDaemons :: FeatureSet -> XIO [(Utf8Builder, Process () () ())]
 startChildDaemons fs = catMaybes <$> mapM start (fsDaemons fs)
   where
     start s@(Sometimes sname _ _) = do
@@ -256,7 +256,7 @@ stopChildDaemons = mapM_ stop
       logInfo $ "stopping child process: " <> n
       liftIO $ killNoWait p
 
-printDeps :: FIO ()
+printDeps :: XIO ()
 printDeps = withDBus_ $ \db -> do
   runIO <- askRunInIO
   let mockCleanup = runCleanup runIO mockClean db
@@ -265,7 +265,7 @@ printDeps = withDBus_ $ \db -> do
           externalBindings mockCleanup db
   let dbus =
         fmap (\f -> f $ dbSesClient db) dbusExporters
-          :: [Sometimes (FIO (), FIO ())]
+          :: [Sometimes (XIO (), XIO ())]
   let others = [runRemovableMon $ dbSysClient db, runPowermon]
   -- TODO might be better to use glog for this?
   mapM_ logInfo $
@@ -286,11 +286,11 @@ printDeps = withDBus_ $ \db -> do
 data Cleanup = Cleanup
   { clChildren :: [(Utf8Builder, Process () () ())]
   , clXmobar :: Maybe (Process Handle () ())
-  , clDBusUnexporters :: [FIO ()]
+  , clDBusUnexporters :: [XIO ()]
   }
 
 runCleanup
-  :: (FIO () -> IO ())
+  :: (XIO () -> IO ())
   -> Cleanup
   -> DBusState
   -> X ()
@@ -773,13 +773,13 @@ data KeyGroup a = KeyGroup
   , kgBindings :: [KeyBinding a]
   }
 
-evalExternal :: [KeyGroup FeatureX] -> FIO [KeyGroup MaybeX]
+evalExternal :: [KeyGroup FeatureX] -> XIO [KeyGroup MaybeX]
 evalExternal = mapM go
   where
     go k@KeyGroup {kgBindings = bs} =
       (\bs' -> k {kgBindings = bs'}) <$> mapM evalKeyBinding bs
 
-evalKeyBinding :: KeyBinding FeatureX -> FIO (KeyBinding MaybeX)
+evalKeyBinding :: KeyBinding FeatureX -> XIO (KeyBinding MaybeX)
 evalKeyBinding k@KeyBinding {kbMaybeAction = a} =
   (\f -> k {kbMaybeAction = f}) <$> evalFeature a
 
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index a28f84d..d90feea 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -53,8 +53,8 @@ module Data.Internal.Dependency
   , dumpSometimes
   , showFulfillment
   -- testing
-  , FIO
-  , withCache
+  , XIO
+  , runXIO
   , evalFeature
   , executeSometimes
   , executeAlways
@@ -128,8 +128,8 @@ import XMonad.Internal.Theme
 
 -- | Run feature evaluation(s) with the cache
 -- Currently there is no easy way to not use this (oh well)
-withCache :: FIO a -> IO a
-withCache x = do
+runXIO :: XIO a -> IO a
+runXIO x = do
   logOpts <- logOptionsHandle stderr False
   pc <- mkDefaultProcessContext
   withLogFunc logOpts $ \f -> do
@@ -138,20 +138,20 @@ withCache x = do
     runRIO s x
 
 -- | Execute an Always immediately
-executeAlways :: Always (IO a) -> FIO a
+executeAlways :: Always (IO a) -> XIO a
 executeAlways = io <=< evalAlways
 
 -- | Execute a Sometimes immediately (or do nothing if failure)
-executeSometimes :: Sometimes (FIO a) -> FIO (Maybe a)
+executeSometimes :: Sometimes (XIO a) -> XIO (Maybe a)
 executeSometimes a = maybe (return Nothing) (fmap Just) =<< evalSometimes a
 
 -- | Possibly return the action of an Always/Sometimes
-evalFeature :: Feature a -> FIO (Maybe a)
+evalFeature :: Feature a -> XIO (Maybe a)
 evalFeature (Right a) = Just <$> evalAlways a
 evalFeature (Left s) = evalSometimes s
 
 -- | Possibly return the action of a Sometimes
-evalSometimes :: Sometimes a -> FIO (Maybe a)
+evalSometimes :: Sometimes a -> XIO (Maybe a)
 evalSometimes x = either goFail goPass =<< evalSometimesMsg x
   where
     goPass (a, ws) = putErrors ws >> return (Just a)
@@ -159,13 +159,13 @@ evalSometimes x = either goFail goPass =<< evalSometimesMsg x
     putErrors = mapM_ logMsg
 
 -- | Return the action of an Always
-evalAlways :: Always a -> FIO a
+evalAlways :: Always a -> XIO a
 evalAlways a = do
   (x, ws) <- evalAlwaysMsg a
   mapM_ logMsg ws
   return x
 
-logMsg :: FMsg -> FIO ()
+logMsg :: FMsg -> XIO ()
 logMsg (FMsg fn n (Msg ll m)) = do
   p <- io getProgName
   f $ Utf8Builder $ encodeUtf8Builder $ T.unwords $ fmt s (T.pack p)
@@ -210,7 +210,7 @@ type AlwaysIO = Always (IO ())
 
 type SometimesX = Sometimes (X ())
 
-type SometimesIO = Sometimes (FIO ())
+type SometimesIO = Sometimes (XIO ())
 
 type Feature a = Either (Sometimes a) (Always a)
 
@@ -290,7 +290,7 @@ type DBusTree_ c = Tree_ (DBusDependency_ c)
 -- | A dependency that only requires IO to evaluate (with payload)
 data IODependency p
   = -- an IO action that yields a payload
-    IORead T.Text [Fulfillment] (FIO (Result p))
+    IORead T.Text [Fulfillment] (XIO (Result p))
   | -- always yields a payload
     IOConst p
   | -- an always that yields a payload
@@ -308,7 +308,7 @@ data DBusDependency_ c
 -- | A dependency that only requires IO to evaluate (no payload)
 data IODependency_
   = IOSystem_ [Fulfillment] SystemDependency
-  | IOTest_ T.Text [Fulfillment] (FIO (Maybe Msg))
+  | IOTest_ T.Text [Fulfillment] (XIO (Maybe Msg))
   | forall a. IOSometimes_ (Sometimes a)
 
 -- | A system component to an IODependency
@@ -377,7 +377,7 @@ data PostFail = PostFail [Msg] | PostMissing Msg
 --------------------------------------------------------------------------------
 -- Configuration
 
-type FIO a = RIO DepStage a
+type XIO a = RIO DepStage a
 
 data DepStage = DepStage
   { dsLogFun :: !LogFunc
@@ -508,7 +508,7 @@ infix 9 .:+
 --------------------------------------------------------------------------------
 -- Testing pipeline
 
-evalSometimesMsg :: Sometimes a -> FIO (Either [FMsg] (a, [FMsg]))
+evalSometimesMsg :: Sometimes a -> XIO (Either [FMsg] (a, [FMsg]))
 evalSometimesMsg (Sometimes n u xs) = do
   r <- asks (u . xpFeatures . dsParams)
   if not r
@@ -522,7 +522,7 @@ evalSometimesMsg (Sometimes n u xs) = do
   where
     dis name = FMsg name Nothing (Msg LevelDebug "feature disabled")
 
-evalAlwaysMsg :: Always a -> FIO (a, [FMsg])
+evalAlwaysMsg :: Always a -> XIO (a, [FMsg])
 evalAlwaysMsg (Always n x) = do
   r <- testAlways x
   return $ case r of
@@ -542,7 +542,7 @@ failedMsg fn Subfeature {sfData = d, sfName = n} = case d of
   where
     f = fmap (FMsg fn (Just n))
 
-testAlways :: Always_ a -> FIO (PostAlways a)
+testAlways :: Always_ a -> XIO (PostAlways a)
 testAlways = go []
   where
     go failed (Option fd next) = do
@@ -552,18 +552,18 @@ testAlways = go []
         (Right pass) -> return $ Primary pass failed next
     go failed (Always_ ar) = (`Fallback` failed) <$> evalFallbackRoot ar
 
-evalFallbackRoot :: FallbackRoot a -> FIO a
+evalFallbackRoot :: FallbackRoot a -> XIO a
 evalFallbackRoot (FallbackAlone a) = return a
 evalFallbackRoot (FallbackTree a s) = a <$> evalFallbackStack s
 
-evalFallbackStack :: FallbackStack p -> FIO p
+evalFallbackStack :: FallbackStack p -> XIO p
 evalFallbackStack (FallbackBottom a) = evalAlways a
 evalFallbackStack (FallbackStack f a as) = do
   ps <- evalFallbackStack as
   p <- evalAlways a
   return $ f p ps
 
-testSometimes :: Sometimes_ a -> FIO (PostSometimes a)
+testSometimes :: Sometimes_ a -> XIO (PostSometimes a)
 testSometimes = go (PostSometimes Nothing [])
   where
     go ts [] = return ts
@@ -573,13 +573,13 @@ testSometimes = go (PostSometimes Nothing [])
         (Left l) -> go (ts {psFailed = l : psFailed ts}) xs
         (Right pass) -> return $ ts {psSuccess = Just pass}
 
-testSubfeature :: SubfeatureRoot a -> FIO (Either SubfeatureFail (SubfeaturePass a))
+testSubfeature :: SubfeatureRoot a -> XIO (Either SubfeatureFail (SubfeaturePass a))
 testSubfeature sf@Subfeature {sfData = t} = do
   t' <- testRoot t
   -- monomorphism restriction :(
   return $ bimap (\n -> sf {sfData = n}) (\n -> sf {sfData = n}) t'
 
-testRoot :: Root a -> FIO (Either PostFail (PostPass a))
+testRoot :: Root a -> XIO (Either PostFail (PostPass a))
 testRoot r = do
   case r of
     (IORoot a t) -> go a testIODep_ testIODep t
@@ -593,7 +593,7 @@ testRoot r = do
             Msg LevelError "client not available"
   where
     -- rank N polymorphism is apparently undecidable...gross
-    go a f_ (f :: forall q. d q -> FIO (MResult q)) t =
+    go a f_ (f :: forall q. d q -> XIO (MResult q)) t =
       bimap PostFail (fmap a) <$> testTree f_ f t
     go_ a f_ t = bimap PostFail (PostPass a) <$> testTree_ f_ t
 
@@ -606,13 +606,13 @@ type MResult p = Memoized (Result p)
 
 testTree
   :: forall d d_ p
-   . (d_ -> FIO MResult_)
-  -> (forall q. d q -> FIO (MResult q))
+   . (d_ -> XIO MResult_)
+  -> (forall q. d q -> XIO (MResult q))
   -> Tree d d_ p
-  -> FIO (Either [Msg] (PostPass p))
+  -> XIO (Either [Msg] (PostPass p))
 testTree test_ test = go
   where
-    go :: forall q. Tree d d_ q -> FIO (Result q)
+    go :: forall q. Tree d d_ q -> XIO (Result q)
     go (And12 f a b) = do
       ra <- go a
       liftRight (\pa -> (and2nd f pa =<<) <$> go b) ra
@@ -629,7 +629,7 @@ testTree test_ test = go
     and2nd f (PostPass pa wa) (PostPass pb wb) = Right $ PostPass (f pa pb) $ wa ++ wb
     liftRight = either (return . Left)
 
-testIODep :: IODependency p -> FIO (MResult p)
+testIODep :: IODependency p -> XIO (MResult p)
 testIODep d = memoizeMVar $ case d of
   IORead _ _ t -> t
   IOConst c -> return $ Right $ PostPass c []
@@ -657,7 +657,7 @@ type Result_ = Either [Msg] [Msg]
 
 type MResult_ = Memoized Result_
 
-testTree_ :: (d -> FIO MResult_) -> Tree_ d -> FIO Result_
+testTree_ :: (d -> XIO MResult_) -> Tree_ d -> XIO Result_
 testTree_ test = go
   where
     go (And_ a b) = either (return . Left) (`test2nd` b) =<< go a
@@ -665,10 +665,10 @@ testTree_ test = go
     go (Only_ a) = runMemoized =<< test a
     test2nd ws = fmap ((Right . (ws ++)) =<<) . go
 
-testIODep_ :: IODependency_ -> FIO MResult_
+testIODep_ :: IODependency_ -> XIO MResult_
 testIODep_ d = memoizeMVar $ testIODepNoCache_ d
 
-testIODepNoCache_ :: IODependency_ -> FIO Result_
+testIODepNoCache_ :: IODependency_ -> XIO Result_
 testIODepNoCache_ (IOSystem_ _ s) = readResult_ <$> testSysDependency s
 testIODepNoCache_ (IOTest_ _ _ t) = readResult_ <$> t
 testIODepNoCache_ (IOSometimes_ x) =
@@ -763,7 +763,7 @@ fontDependency_ fam ful = IOTest_ (fontTestName fam) ful $ voidRead <$> testFont
 fontTestName :: T.Text -> T.Text
 fontTestName fam = T.unwords ["test if font", singleQuote fam, "exists"]
 
--- testFont :: T.Text -> FIO (Result FontBuilder)
+-- testFont :: T.Text -> XIO (Result FontBuilder)
 -- testFont = liftIO . testFont'
 
 testFont
@@ -821,7 +821,7 @@ readInterface n f = IORead n [] go
 --------------------------------------------------------------------------------
 -- Misc testers
 
-socketExists :: T.Text -> [Fulfillment] -> FIO FilePath -> IODependency_
+socketExists :: T.Text -> [Fulfillment] -> XIO FilePath -> IODependency_
 socketExists n ful =
   IOTest_ (T.unwords ["test if", n, "socket exists"]) ful . socketExists'
 
@@ -845,10 +845,10 @@ introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
 introspectMethod :: MemberName
 introspectMethod = memberName_ "Introspect"
 
-testDBusDep_ :: SafeClient c => c -> DBusDependency_ c -> FIO MResult_
+testDBusDep_ :: SafeClient c => c -> DBusDependency_ c -> XIO MResult_
 testDBusDep_ c d = memoizeMVar $ testDBusDepNoCache_ c d
 
-testDBusDepNoCache_ :: SafeClient c => c -> DBusDependency_ c -> FIO Result_
+testDBusDepNoCache_ :: SafeClient c => c -> DBusDependency_ c -> XIO Result_
 testDBusDepNoCache_ cl (Bus _ bus) = io $ do
   ret <- callMethod cl queryBus queryPath queryIface queryMem
   return $ case ret of
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index d678eb0..1aef07a 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -264,7 +264,7 @@ runNotificationContext =
 -- System commands
 
 -- this is required for some vpn's to work properly with network-manager
-runNetAppDaemon :: Maybe SysClient -> Sometimes (FIO (P.Process () () ()))
+runNetAppDaemon :: Maybe SysClient -> Sometimes (XIO (P.Process () () ()))
 runNetAppDaemon cl =
   Sometimes
     "network applet"
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index 70b9c12..adc5477 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -84,7 +84,7 @@ runReboot = spawn "systemctl reboot"
 --------------------------------------------------------------------------------
 -- Autolock
 
-runAutolock :: Sometimes (FIO (P.Process () () ()))
+runAutolock :: Sometimes (XIO (P.Process () () ()))
 runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
   where
     tree =
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 584a618..846c13d 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -102,9 +102,9 @@ disconnectDBusX db = do
 
 withDBusInterfaces
   :: DBusState
-  -> [Maybe SesClient -> Sometimes (FIO (), FIO ())]
-  -> ([FIO ()] -> FIO a)
-  -> FIO a
+  -> [Maybe SesClient -> Sometimes (XIO (), XIO ())]
+  -> ([XIO ()] -> XIO a)
+  -> XIO a
 withDBusInterfaces db interfaces = bracket up sequence
   where
     up = do

From 17ebd0137f1430e955674f330819fb3b4b43401b Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 18:06:48 -0500
Subject: [PATCH 077/118] ENH tweak logging

---
 bin/xmobar.hs                   | 5 +++++
 lib/Data/Internal/Dependency.hs | 2 +-
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index fe6f300..ac6292d 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -75,6 +75,11 @@ run :: XIO ()
 run = do
   -- IDK why this is needed, I thought this was default
   liftIO $ hSetBuffering stdout LineBuffering
+  -- this isn't totally necessary except for the fact that killing xmobar
+  -- will make it print something about catching SIGTERM, and without
+  -- linebuffering it usually only prints the first few characters (even then
+  -- it only prints 10-20% of the time)
+  liftIO $ hSetBuffering stderr LineBuffering
   withDBus_ $ \db -> do
     c <- evalConfig db
     liftIO $ xmobar c
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs
index d90feea..68a60c4 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
@@ -130,7 +130,7 @@ import XMonad.Internal.Theme
 -- Currently there is no easy way to not use this (oh well)
 runXIO :: XIO a -> IO a
 runXIO x = do
-  logOpts <- logOptionsHandle stderr False
+  logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle stderr False
   pc <- mkDefaultProcessContext
   withLogFunc logOpts $ \f -> do
     p <- getParams

From 1b4480ac3a160a06d2bd4fb4dd7b404792833a70 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 18:33:02 -0500
Subject: [PATCH 078/118] REF rename a bunch of stuff

---
 bin/xmobar.hs                                 |  2 +-
 bin/xmonad.hs                                 |  2 +-
 lib/Data/Internal/{Dependency.hs => XIO.hs}   | 25 ++++++++++---------
 lib/XMonad/Internal/Command/DMenu.hs          |  2 +-
 lib/XMonad/Internal/Command/Desktop.hs        |  2 +-
 lib/XMonad/Internal/Command/Power.hs          |  2 +-
 lib/XMonad/Internal/Concurrent/ACPIEvent.hs   |  2 +-
 .../Internal/Concurrent/DynamicWorkspaces.hs  | 23 +++++++++--------
 lib/XMonad/Internal/Concurrent/VirtualBox.hs  |  2 +-
 .../Internal/DBus/Brightness/ClevoKeyboard.hs |  2 +-
 lib/XMonad/Internal/DBus/Brightness/Common.hs |  2 +-
 .../DBus/Brightness/IntelBacklight.hs         |  2 +-
 lib/XMonad/Internal/DBus/Control.hs           |  2 +-
 lib/XMonad/Internal/DBus/Removable.hs         |  2 +-
 lib/XMonad/Internal/DBus/Screensaver.hs       |  2 +-
 lib/Xmobar/Plugins/Bluetooth.hs               |  2 +-
 lib/Xmobar/Plugins/Device.hs                  |  2 +-
 lib/Xmobar/Plugins/VPN.hs                     |  2 +-
 18 files changed, 41 insertions(+), 39 deletions(-)
 rename lib/Data/Internal/{Dependency.hs => XIO.hs} (98%)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index ac6292d..ae5c4d8 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -12,7 +12,7 @@
 module Main (main) where
 
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import Options.Applicative
 import RIO hiding (hFlush)
 import qualified RIO.ByteString.Lazy as BL
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index e1708bc..841e29a 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -10,7 +10,7 @@
 module Main (main) where
 
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import Data.Monoid
 import Data.Text.IO (hPutStrLn)
 import Graphics.X11.Types
diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/XIO.hs
similarity index 98%
rename from lib/Data/Internal/Dependency.hs
rename to lib/Data/Internal/XIO.hs
index 68a60c4..27dfe29 100644
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/XIO.hs
@@ -8,7 +8,7 @@
 --------------------------------------------------------------------------------
 -- Functions for handling dependencies
 
-module Data.Internal.Dependency
+module Data.Internal.XIO
 -- feature types
   ( Feature
   , Always (..)
@@ -26,6 +26,7 @@ module Data.Internal.Dependency
   , SubfeatureRoot
   , Msg (..)
   -- configuration
+  , XEnv (..)
   , XParams (..)
   , XPFeatures (..)
   , XPQuery
@@ -134,7 +135,7 @@ runXIO x = do
   pc <- mkDefaultProcessContext
   withLogFunc logOpts $ \f -> do
     p <- getParams
-    let s = DepStage f pc p
+    let s = XEnv f pc p
     runRIO s x
 
 -- | Execute an Always immediately
@@ -377,19 +378,19 @@ data PostFail = PostFail [Msg] | PostMissing Msg
 --------------------------------------------------------------------------------
 -- Configuration
 
-type XIO a = RIO DepStage a
+type XIO a = RIO XEnv a
 
-data DepStage = DepStage
-  { dsLogFun :: !LogFunc
-  , dsProcCxt :: !ProcessContext
-  , dsParams :: !XParams
+data XEnv = XEnv
+  { xLogFun :: !LogFunc
+  , xProcCxt :: !ProcessContext
+  , xParams :: !XParams
   }
 
-instance HasLogFunc DepStage where
-  logFuncL = lens dsLogFun (\x y -> x {dsLogFun = y})
+instance HasLogFunc XEnv where
+  logFuncL = lens xLogFun (\x y -> x {xLogFun = y})
 
-instance HasProcessContext DepStage where
-  processContextL = lens dsProcCxt (\x y -> x {dsProcCxt = y})
+instance HasProcessContext XEnv where
+  processContextL = lens xProcCxt (\x y -> x {xProcCxt = y})
 
 data XParams = XParams
   { xpLogLevel :: LogLevel
@@ -510,7 +511,7 @@ infix 9 .:+
 
 evalSometimesMsg :: Sometimes a -> XIO (Either [FMsg] (a, [FMsg]))
 evalSometimesMsg (Sometimes n u xs) = do
-  r <- asks (u . xpFeatures . dsParams)
+  r <- asks (u . xpFeatures . xParams)
   if not r
     then return $ Left [dis n]
     else do
diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index 710d15c..2614feb 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -20,7 +20,7 @@ where
 
 import DBus
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import Graphics.X11.Types
 import RIO.Directory
   ( XdgDirectory (..)
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 1aef07a..0ed6eae 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -41,7 +41,7 @@ where
 
 import DBus
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import RIO
 import RIO.Directory
 import RIO.FilePath
diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index adc5477..125030c 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -26,7 +26,7 @@ module XMonad.Internal.Command.Power
   )
 where
 
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import Graphics.X11.Types
 import RIO
 import RIO.Directory
diff --git a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
index d32edee..756dd33 100644
--- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
+++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
@@ -10,7 +10,7 @@ module XMonad.Internal.Concurrent.ACPIEvent
   )
 where
 
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import Network.Socket
 import Network.Socket.ByteString
 import RIO
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index 6a64909..e61b263 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -88,13 +88,14 @@ data DynWorkspace = DynWorkspace
 -- the same as that in XMonad itself (eg with Query types)
 -- type MatchTags = M.Map String String
 
-data WConf = WConf
-  { display :: Display
-  , dynWorkspaces :: [DynWorkspace]
-  , curPIDs :: MVar (S.Set Pid)
+data WEnv = WEnv
+  { wDisplay :: !Display
+  , wDynWorkspaces :: ![DynWorkspace]
+  , wCurPIDs :: !(MVar (S.Set Pid))
+  -- , wXEnv :: !XEnv
   }
 
-type W a = RIO WConf ()
+type WIO a = RIO WEnv a
 
 runWorkspaceMon :: [DynWorkspace] -> IO ()
 runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
@@ -107,19 +108,19 @@ runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
   where
     withEvents dpy e = do
       ps <- newMVar S.empty
-      let c = WConf {display = dpy, dynWorkspaces = dws, curPIDs = ps}
+      let c = WEnv {wDisplay = dpy, wDynWorkspaces = dws, wCurPIDs = ps}
       runRIO c $
         forever $
           handleEvent =<< io (nextEvent dpy e >> getEvent e)
 
-handleEvent :: Event -> W ()
+handleEvent :: Event -> WIO ()
 
 -- | assume this fires at least once when a new window is created (also could
 -- use CreateNotify but that is really noisy)
 handleEvent MapNotifyEvent {ev_window = w} = do
-  dpy <- asks display
+  dpy <- asks wDisplay
   hint <- io $ getClassHint dpy w
-  dws <- asks dynWorkspaces
+  dws <- asks wDynWorkspaces
   let tag =
         M.lookup (resClass hint) $
           M.fromList $
@@ -133,9 +134,9 @@ handleEvent MapNotifyEvent {ev_window = w} = do
       _ -> return ()
 handleEvent _ = return ()
 
-withUniquePid :: Pid -> String -> W ()
+withUniquePid :: Pid -> String -> WIO ()
 withUniquePid pid tag = do
-  ps <- asks curPIDs
+  ps <- asks wCurPIDs
   pids <- readMVar ps
   io
     $ unless (pid `elem` pids)
diff --git a/lib/XMonad/Internal/Concurrent/VirtualBox.hs b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
index 6940e60..5997478 100644
--- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs
+++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
@@ -11,7 +11,7 @@ module XMonad.Internal.Concurrent.VirtualBox
   )
 where
 
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import RIO hiding (try)
 import RIO.Directory
 import RIO.FilePath
diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
index 7ca50d1..e2776d5 100644
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@@ -15,7 +15,7 @@ where
 
 import DBus
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import RIO
 import RIO.FilePath
 import XMonad.Internal.DBus.Brightness.Common
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 4c91b75..731c3b2 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -18,7 +18,7 @@ import DBus
 import DBus.Client
 import qualified DBus.Introspection as I
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import RIO
 import qualified RIO.Text as T
 import XMonad.Core (io)
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index 9b15321..7a4b89d 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@@ -15,7 +15,7 @@ where
 
 import DBus
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import RIO
 import RIO.FilePath
 import XMonad.Internal.DBus.Brightness.Common
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 846c13d..a2c573b 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -27,7 +27,7 @@ where
 import DBus
 import DBus.Client
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs
index e338f05..ab58373 100644
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@@ -11,7 +11,7 @@ module XMonad.Internal.DBus.Removable (runRemovableMon) where
 import DBus
 import DBus.Client
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import RIO
 import qualified RIO.Map as M
 import XMonad.Core (io)
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 8d385d6..bb72129 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -16,7 +16,7 @@ import DBus
 import DBus.Client
 import qualified DBus.Introspection as I
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import Graphics.X11.XScreenSaver
 import RIO
 import XMonad.Internal.DBus.Common
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 9886c32..2c74586 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -42,7 +42,7 @@ where
 import DBus
 import DBus.Client
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import RIO
 import RIO.FilePath
 import RIO.List
diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index 9cc7ba1..967e5dd 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -14,7 +14,7 @@ where
 
 import DBus
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.Command.Desktop
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index e4be4d5..0550479 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -16,7 +16,7 @@ where
 
 import DBus
 import Data.Internal.DBus
-import Data.Internal.Dependency
+import Data.Internal.XIO
 import RIO
 import qualified RIO.Map as M
 import qualified RIO.Set as S

From 76011dc6d654f687e683b23710fcdd8fc0b7b7da Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 19:23:31 -0500
Subject: [PATCH 079/118] ENH use logging in dynamic workspace thread

---
 bin/xmonad.hs                                 |  2 +-
 .../Internal/Concurrent/DynamicWorkspaces.hs  | 41 ++++++++++++++-----
 2 files changed, 32 insertions(+), 11 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 841e29a..2380e6d 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -149,7 +149,7 @@ run = do
   where
     startDynWorkspaces fs = do
       dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
-      void $ io $ async $ runWorkspaceMon dws
+      void $ async $ runWorkspaceMon dws
       return dws
 
 runXMonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index e61b263..3e18c11 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Automatically Manage Dynamic Workspaces
 -- This is a somewhat convoluted wrapper for the Dymamic Workspaces module
@@ -34,6 +36,8 @@ module XMonad.Internal.Concurrent.DynamicWorkspaces
   )
 where
 
+import qualified Data.ByteString.Char8 as BC
+import Data.Internal.XIO
 import Graphics.X11.Types
 import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Display
@@ -92,24 +96,34 @@ data WEnv = WEnv
   { wDisplay :: !Display
   , wDynWorkspaces :: ![DynWorkspace]
   , wCurPIDs :: !(MVar (S.Set Pid))
-  -- , wXEnv :: !XEnv
+  , wXEnv :: !XEnv
   }
 
+instance HasLogFunc WEnv where
+  logFuncL = lens wXEnv (\x y -> x {wXEnv = y}) . logFuncL
+
 type WIO a = RIO WEnv a
 
-runWorkspaceMon :: [DynWorkspace] -> IO ()
+runWorkspaceMon :: [DynWorkspace] -> XIO ()
 runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
-  root <- rootWindow dpy $ defaultScreen dpy
+  root <- liftIO $ rootWindow dpy $ defaultScreen dpy
   -- listen only for substructure change events (which includes MapNotify)
-  allocaSetWindowAttributes $ \a -> do
+  liftIO $ allocaSetWindowAttributes $ \a -> do
     set_event_mask a substructureNotifyMask
     changeWindowAttributes dpy root cWEventMask a
-  void $ allocaXEvent $ withEvents dpy
+  withRunInIO $ \runIO -> do
+    void $ allocaXEvent $ runIO . withEvents dpy
   where
+    wrapEnv dpy ps x =
+      WEnv
+        { wDisplay = dpy
+        , wDynWorkspaces = dws
+        , wCurPIDs = ps
+        , wXEnv = x
+        }
     withEvents dpy e = do
       ps <- newMVar S.empty
-      let c = WEnv {wDisplay = dpy, wDynWorkspaces = dws, wCurPIDs = ps}
-      runRIO c $
+      mapRIO (wrapEnv dpy ps) $ do
         forever $
           handleEvent =<< io (nextEvent dpy e >> getEvent e)
 
@@ -138,17 +152,24 @@ withUniquePid :: Pid -> String -> WIO ()
 withUniquePid pid tag = do
   ps <- asks wCurPIDs
   pids <- readMVar ps
-  io
-    $ unless (pid `elem` pids)
+  unless (pid `elem` pids)
     $ bracket_
       (modifyMVar_ ps (return . S.insert pid))
       (modifyMVar_ ps (return . S.delete pid))
-    $ waitUntilExit pid >> sendXMsg Workspace tag
+    $ do
+      logInfo $ "waiting for pid " <> pid_ <> " to exit on workspace " <> tag_
+      waitUntilExit pid
+      logInfo $ "pid " <> pid_ <> " exited on workspace " <> tag_
+      liftIO $ sendXMsg Workspace tag
+  where
+    pid_ = "'" <> displayShow pid <> "'"
+    tag_ = "'" <> displayBytesUtf8 (BC.pack tag) <> "'"
 
 --------------------------------------------------------------------------------
 -- Launching apps
 -- When launching apps on dymamic workspaces, first check if they are running
 -- and launch if not, then switch to their workspace
+
 wsOccupied :: Eq a1 => a1 -> W.StackSet a1 l a2 sid sd -> Bool
 wsOccupied tag ws =
   elem tag $

From e0913a461d98028732e563d644d9ee9a00ee6056 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 19:41:46 -0500
Subject: [PATCH 080/118] ENH log internal dbus methods (kinda)

---
 lib/Data/Internal/DBus.hs       | 24 +++++++++++++++++-------
 lib/Xmobar/Plugins/Bluetooth.hs | 20 ++++++++++++--------
 lib/Xmobar/Plugins/VPN.hs       | 12 ++++++++++--
 3 files changed, 39 insertions(+), 17 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 0fa93be..964066d 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -128,8 +128,18 @@ methodCallBus b p i m =
 dbusInterface :: InterfaceName
 dbusInterface = interfaceName_ "org.freedesktop.DBus"
 
-callGetNameOwner :: (MonadUnliftIO m, SafeClient c) => c -> BusName -> m (Maybe BusName)
-callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
+callGetNameOwner
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
+  => c
+  -> BusName
+  -> m (Maybe BusName)
+callGetNameOwner cl name = do
+  res <- callMethod' cl mc
+  case res of
+    Left err -> do
+      logError $ Utf8Builder $ encodeUtf8Builder err
+      return Nothing
+    Right body -> return $ fromSingletonVariant body
   where
     mc =
       (methodCallBus dbusName dbusPath dbusInterface mem)
@@ -175,7 +185,7 @@ matchSignal b p i m =
     }
 
 matchSignalFull
-  :: (MonadUnliftIO m, SafeClient c)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
   => c
   -> BusName
   -> Maybe ObjectPath
@@ -213,7 +223,7 @@ matchProperty b p =
   matchSignal b p (Just propertyInterface) (Just propertySignal)
 
 matchPropertyFull
-  :: (MonadUnliftIO m, SafeClient c)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
   => c
   -> BusName
   -> Maybe ObjectPath
@@ -275,7 +285,7 @@ callGetManagedObjects cl bus path =
     <$> callMethod cl bus path omInterface getManagedObjects
 
 addInterfaceChangedListener
-  :: (MonadUnliftIO m, SafeClient c)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
   => BusName
   -> MemberName
   -> ObjectPath
@@ -287,7 +297,7 @@ addInterfaceChangedListener bus prop path sc cl = do
   forM rule $ \r -> addMatchCallback r sc cl
 
 addInterfaceAddedListener
-  :: (MonadUnliftIO m, SafeClient c)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
   => BusName
   -> ObjectPath
   -> SignalCallback m
@@ -297,7 +307,7 @@ addInterfaceAddedListener bus =
   addInterfaceChangedListener bus omInterfacesAdded
 
 addInterfaceRemovedListener
-  :: (MonadUnliftIO m, SafeClient c)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
   => BusName
   -> ObjectPath
   -> SignalCallback m
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 2c74586..e3bfb92 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -68,7 +68,7 @@ instance Exec Bluetooth where
     withDBusClientConnection cb $ startAdapter icons colors cb
 
 startAdapter
-  :: MonadUnliftIO m
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => Icons
   -> Colors
   -> Callback
@@ -170,11 +170,15 @@ getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
 btOMPath :: ObjectPath
 btOMPath = objectPath_ "/"
 
-addBtOMListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
+addBtOMListener
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SignalCallback m
+  -> SysClient
+  -> m ()
 addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
 
 addDeviceAddedListener
-  :: MonadUnliftIO m
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => MutableBtState
   -> m ()
   -> ObjectPath
@@ -187,7 +191,7 @@ addDeviceAddedListener state dpy adapter client =
       addAndInitDevice state dpy d client
 
 addDeviceRemovedListener
-  :: (MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => MutableBtState
   -> m ()
   -> ObjectPath
@@ -219,14 +223,14 @@ initAdapter state adapter client = do
   putPowered state $ fromSingletonVariant reply
 
 matchBTProperty
-  :: (MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => SysClient
   -> ObjectPath
   -> m (Maybe MatchRule)
 matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
 
 addAdaptorListener
-  :: MonadUnliftIO m
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => MutableBtState
   -> m ()
   -> ObjectPath
@@ -263,7 +267,7 @@ adaptorPowered = "Powered"
 -- Devices
 
 addAndInitDevice
-  :: MonadUnliftIO m
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => MutableBtState
   -> m ()
   -> ObjectPath
@@ -291,7 +295,7 @@ initDevice state sh device sys = do
         }
 
 addDeviceListener
-  :: MonadUnliftIO m
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => MutableBtState
   -> m ()
   -> ObjectPath
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index 0550479..5c50618 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -77,10 +77,18 @@ getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
 findTunnels :: ObjectTree -> VPNState
 findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
 
-vpnAddedListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
+vpnAddedListener
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SignalCallback m
+  -> SysClient
+  -> m ()
 vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
 
-vpnRemovedListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
+vpnRemovedListener
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SignalCallback m
+  -> SysClient
+  -> m ()
 vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
 
 addedCallback :: MonadUnliftIO m => MutableVPNState -> m () -> SignalCallback m

From 5912e705267778bf486d0982ce4163bcf861f56a Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 19:52:01 -0500
Subject: [PATCH 081/118] ENH log errors for dbus property query

---
 lib/Data/Internal/DBus.hs       | 15 +++++++++------
 lib/Xmobar/Plugins/Bluetooth.hs | 16 ++++++++++++----
 lib/Xmobar/Plugins/Device.hs    |  6 +++++-
 3 files changed, 26 insertions(+), 11 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 964066d..baf64a0 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -33,6 +33,7 @@ where
 
 import DBus
 import DBus.Client
+import qualified Data.ByteString.Char8 as BC
 import RIO
 import qualified RIO.Map as M
 import qualified RIO.Text as T
@@ -205,18 +206,20 @@ propertySignal :: MemberName
 propertySignal = memberName_ "PropertiesChanged"
 
 callPropertyGet
-  :: (MonadUnliftIO m, SafeClient c)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
   => BusName
   -> ObjectPath
   -> InterfaceName
   -> MemberName
   -> c
   -> m [Variant]
-callPropertyGet bus path iface property cl =
-  liftIO $
-    fmap (either (const []) (: [])) $
-      getProperty (toClient cl) $
-        methodCallBus bus path iface property
+callPropertyGet bus path iface property cl = do
+  res <- liftIO $ getProperty (toClient cl) $ methodCallBus bus path iface property
+  case res of
+    Left err -> do
+      logError $ displayBytesUtf8 $ BC.pack $ methodErrorMessage err
+      return []
+    Right v -> return [v]
 
 matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
 matchProperty b p =
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index e3bfb92..4173ca8 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -213,7 +213,7 @@ pathCallback _ _ _ _ = return ()
 -- Adapter
 
 initAdapter
-  :: (MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => MutableBtState
   -> ObjectPath
   -> SysClient
@@ -242,7 +242,11 @@ addAdaptorListener state dpy adaptor sys = do
   where
     procMatch = withSignalMatch $ \b -> putPowered state b >> dpy
 
-callGetPowered :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
+callGetPowered
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => ObjectPath
+  -> SysClient
+  -> m [Variant]
 callGetPowered adapter =
   callPropertyGet btBus adapter adapterInterface $
     memberName_ $
@@ -279,7 +283,7 @@ addAndInitDevice state dpy device client = do
   forM_ sh $ \s -> initDevice state s device client
 
 initDevice
-  :: MonadUnliftIO m
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => MutableBtState
   -> SignalHandler
   -> ObjectPath
@@ -310,7 +314,11 @@ addDeviceListener state dpy device sys = do
 matchConnected :: [Variant] -> SignalMatch Bool
 matchConnected = matchPropertyChanged devInterface devConnected
 
-callGetConnected :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
+callGetConnected
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => ObjectPath
+  -> SysClient
+  -> m [Variant]
 callGetConnected p =
   callPropertyGet btBus p devInterface $
     memberName_ (T.unpack devConnected)
diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index 967e5dd..220a297 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -52,7 +52,11 @@ getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
         { methodCallBody = [toVariant iface]
         }
 
-getDeviceConnected :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
+getDeviceConnected
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => ObjectPath
+  -> SysClient
+  -> m [Variant]
 getDeviceConnected path =
   callPropertyGet networkManagerBus path nmDeviceInterface $
     memberName_ $

From 6848fbe01f2b73086ecceeee5f619723142b2fea Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 19:58:23 -0500
Subject: [PATCH 082/118] ENH log errors when getting managed objects

---
 lib/Data/Internal/DBus.hs       | 15 +++++++++++----
 lib/Xmobar/Plugins/Bluetooth.hs |  5 ++++-
 lib/Xmobar/Plugins/VPN.hs       | 10 ++++++++--
 3 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index baf64a0..c18bc8d 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -278,14 +278,21 @@ omInterfacesRemoved :: MemberName
 omInterfacesRemoved = memberName_ "InterfacesRemoved"
 
 callGetManagedObjects
-  :: (MonadUnliftIO m, SafeClient c)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
   => c
   -> BusName
   -> ObjectPath
   -> m ObjectTree
-callGetManagedObjects cl bus path =
-  either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
-    <$> callMethod cl bus path omInterface getManagedObjects
+callGetManagedObjects cl bus path = do
+  res <- callMethod cl bus path omInterface getManagedObjects
+  case res of
+    Left err -> do
+      logError $ Utf8Builder $ encodeUtf8Builder err
+      return M.empty
+    Right v -> return $ fromMaybe M.empty $ fromSingletonVariant v
+
+-- either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
+--   <$>
 
 addInterfaceChangedListener
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 4173ca8..58536c0 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -164,7 +164,10 @@ adaptorHasDevice adaptor device = case splitPathNoRoot device of
 splitPathNoRoot :: ObjectPath -> [FilePath]
 splitPathNoRoot = dropWhile (== "/") . splitDirectories . formatObjectPath
 
-getBtObjectTree :: MonadUnliftIO m => SysClient -> m ObjectTree
+getBtObjectTree
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SysClient
+  -> m ObjectTree
 getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
 
 btOMPath :: ObjectPath
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index 5c50618..0de5391 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -52,7 +52,10 @@ type VPNState = S.Set ObjectPath
 
 type MutableVPNState = MVar VPNState
 
-initState :: MonadUnliftIO m => SysClient -> m MutableVPNState
+initState
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SysClient
+  -> m MutableVPNState
 initState client = do
   ot <- getVPNObjectTree client
   newMVar $ findTunnels ot
@@ -71,7 +74,10 @@ updateState f state op = modifyMVar_ state $ return . f op
 --------------------------------------------------------------------------------
 -- Tunnel Device Detection
 
-getVPNObjectTree :: MonadUnliftIO m => SysClient -> m ObjectTree
+getVPNObjectTree
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SysClient
+  -> m ObjectTree
 getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
 
 findTunnels :: ObjectTree -> VPNState

From 04a7a707471ea8a4c615e12a3bee4df0bbd861f8 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 20:37:06 -0500
Subject: [PATCH 083/118] ENH log errors when adding signal matchers

---
 lib/Data/Internal/DBus.hs | 66 +++++++++++++++++++++++++++++++++------
 1 file changed, 57 insertions(+), 9 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index c18bc8d..409716e 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -35,6 +35,7 @@ import DBus
 import DBus.Client
 import qualified Data.ByteString.Char8 as BC
 import RIO
+import RIO.List
 import qualified RIO.Map as M
 import qualified RIO.Text as T
 
@@ -92,7 +93,7 @@ getDBusClient' sys = do
   res <- try $ liftIO $ if sys then connectSystem else connectSession
   case res of
     Left e -> do
-      logInfo $ Utf8Builder $ encodeUtf8Builder $ T.pack $ clientErrorMessage e
+      logInfo $ displayBytesUtf8 $ BC.pack $ clientErrorMessage e
       return Nothing
     Right c -> return $ Just c
 
@@ -151,6 +152,7 @@ callGetNameOwner cl name = do
 --------------------------------------------------------------------------------
 -- Variant parsing
 
+-- TODO log failures here?
 fromSingletonVariant :: IsVariant a => [Variant] -> Maybe a
 fromSingletonVariant = fromVariant <=< listToMaybe
 
@@ -193,8 +195,25 @@ matchSignalFull
   -> Maybe InterfaceName
   -> Maybe MemberName
   -> m (Maybe MatchRule)
-matchSignalFull client b p i m =
-  fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
+matchSignalFull client b p i m = do
+  res <- callGetNameOwner client b
+  case res of
+    Just o -> return $ Just $ matchSignal (Just o) p i m
+    Nothing -> do
+      logError $
+        "could not add signal matcher on bus " <> bus_ <> " with match: " <> match
+      return Nothing
+  where
+    bus_ = displayWrapQuote $ displayBusName b
+    iface_ = displayWrapQuote . displayInterfaceName <$> i
+    path_ = displayWrapQuote . displayObjectPath <$> p
+    mem_ = displayWrapQuote . displayMemberName <$> m
+    match =
+      displayWrapQuote $
+        mconcat $
+          intersperse ", " $
+            mapMaybe (\(k, v) -> fmap ((k <> "=") <>) v) $
+              zip ["interface", "path", "member"] [iface_, path_, mem_]
 
 --------------------------------------------------------------------------------
 -- Properties
@@ -291,9 +310,6 @@ callGetManagedObjects cl bus path = do
       return M.empty
     Right v -> return $ fromMaybe M.empty $ fromSingletonVariant v
 
--- either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
---   <$>
-
 addInterfaceChangedListener
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
   => BusName
@@ -303,8 +319,22 @@ addInterfaceChangedListener
   -> c
   -> m (Maybe SignalHandler)
 addInterfaceChangedListener bus prop path sc cl = do
-  rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
-  forM rule $ \r -> addMatchCallback r sc cl
+  res <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
+  case res of
+    Nothing -> do
+      logError $
+        "could not add listener for property"
+          <> prop_
+          <> " at path "
+          <> path_
+          <> " on bus "
+          <> bus_
+      return Nothing
+    Just rule -> Just <$> addMatchCallback rule sc cl
+  where
+    bus_ = "'" <> displayBusName bus <> "'"
+    path_ = "'" <> displayObjectPath path <> "'"
+    prop_ = "'" <> displayMemberName prop <> "'"
 
 addInterfaceAddedListener
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
@@ -345,4 +375,22 @@ exportPair path toIface cl = (up, down)
     down = do
       logInfo $ "removing interface: " <> path_
       liftIO $ unexport cl_ path
-    path_ = Utf8Builder $ encodeUtf8Builder $ T.pack $ formatObjectPath path
+    path_ = displayObjectPath path
+
+--------------------------------------------------------------------------------
+-- logging helpers
+
+displayBusName :: BusName -> Utf8Builder
+displayBusName = displayBytesUtf8 . BC.pack . formatBusName
+
+displayObjectPath :: ObjectPath -> Utf8Builder
+displayObjectPath = displayBytesUtf8 . BC.pack . formatObjectPath
+
+displayMemberName :: MemberName -> Utf8Builder
+displayMemberName = displayBytesUtf8 . BC.pack . formatMemberName
+
+displayInterfaceName :: InterfaceName -> Utf8Builder
+displayInterfaceName = displayBytesUtf8 . BC.pack . formatInterfaceName
+
+displayWrapQuote :: Utf8Builder -> Utf8Builder
+displayWrapQuote x = "'" <> x <> "'"

From 7432a8f8417ada1e433e29f74b2647a9e7799029 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 21:30:07 -0500
Subject: [PATCH 084/118] ENH log failures for bluetooth listeners

---
 lib/Data/Internal/DBus.hs       | 18 ++++++++------
 lib/Xmobar/Plugins/Bluetooth.hs | 44 +++++++++++++++++++++++----------
 2 files changed, 42 insertions(+), 20 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 409716e..69651a1 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -28,6 +28,11 @@ module Data.Internal.DBus
   , fromSingletonVariant
   , bodyToMaybe
   , exportPair
+  , displayBusName
+  , displayObjectPath
+  , displayMemberName
+  , displayInterfaceName
+  , displayWrapQuote
   )
 where
 
@@ -200,8 +205,7 @@ matchSignalFull client b p i m = do
   case res of
     Just o -> return $ Just $ matchSignal (Just o) p i m
     Nothing -> do
-      logError $
-        "could not add signal matcher on bus " <> bus_ <> " with match: " <> match
+      logError msg
       return Nothing
   where
     bus_ = displayWrapQuote $ displayBusName b
@@ -209,11 +213,11 @@ matchSignalFull client b p i m = do
     path_ = displayWrapQuote . displayObjectPath <$> p
     mem_ = displayWrapQuote . displayMemberName <$> m
     match =
-      displayWrapQuote $
-        mconcat $
-          intersperse ", " $
-            mapMaybe (\(k, v) -> fmap ((k <> "=") <>) v) $
-              zip ["interface", "path", "member"] [iface_, path_, mem_]
+      intersperse ", " $
+        mapMaybe (\(k, v) -> fmap ((k <> "=") <>) v) $
+          zip ["interface", "path", "member"] [iface_, path_, mem_]
+    stem = "could not get match rule for bus " <> bus_
+    msg = if null match then stem else stem <> " where " <> mconcat match
 
 --------------------------------------------------------------------------------
 -- Properties
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 58536c0..e5acde8 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -81,7 +81,6 @@ startAdapter is cs cb cl = do
   forM_ (findAdapter ot) $ \adapter -> do
     -- set up adapter
     initAdapter state adapter cl
-    -- TODO this step could fail; at least warn the user...
     void $ addAdaptorListener state dpy adapter cl
     -- set up devices on the adapter (and listeners for adding/removing devices)
     let devices = findDevices adapter ot
@@ -223,6 +222,8 @@ initAdapter
   -> m ()
 initAdapter state adapter client = do
   reply <- callGetPowered adapter client
+  -- TODO this could fail if the variant is something weird; the only
+  -- indication I will get is "NA"
   putPowered state $ fromSingletonVariant reply
 
 matchBTProperty
@@ -232,6 +233,31 @@ matchBTProperty
   -> m (Maybe MatchRule)
 matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
 
+withBTPropertyRule
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, IsVariant a)
+  => SysClient
+  -> ObjectPath
+  -> (Maybe a -> m ())
+  -> InterfaceName
+  -> T.Text
+  -> m (Maybe SignalHandler)
+withBTPropertyRule cl path update iface prop = do
+  res <- matchBTProperty cl path
+  case res of
+    Just rule -> Just <$> addMatchCallback rule (signalToUpdate . matchConnected) cl
+    Nothing -> do
+      logError $
+        "could not add listener for prop "
+          <> prop_
+          <> " on path "
+          <> path_
+      return Nothing
+  where
+    path_ = displayObjectPath path
+    prop_ = Utf8Builder $ encodeUtf8Builder prop
+    signalToUpdate = withSignalMatch update
+    matchConnected = matchPropertyChanged iface prop
+
 addAdaptorListener
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => MutableBtState
@@ -240,10 +266,9 @@ addAdaptorListener
   -> SysClient
   -> m (Maybe SignalHandler)
 addAdaptorListener state dpy adaptor sys = do
-  rule <- matchBTProperty sys adaptor
-  forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) sys
+  withBTPropertyRule sys adaptor procMatch adapterInterface adaptorPowered
   where
-    procMatch = withSignalMatch $ \b -> putPowered state b >> dpy
+    procMatch b = putPowered state b >> dpy
 
 callGetPowered
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
@@ -255,9 +280,6 @@ callGetPowered adapter =
     memberName_ $
       T.unpack adaptorPowered
 
-matchPowered :: [Variant] -> SignalMatch Bool
-matchPowered = matchPropertyChanged adapterInterface adaptorPowered
-
 putPowered :: MonadUnliftIO m => MutableBtState -> Maybe Bool -> m ()
 putPowered m ds = modifyMVar_ m (\s -> return s {btPowered = ds})
 
@@ -309,13 +331,9 @@ addDeviceListener
   -> SysClient
   -> m (Maybe SignalHandler)
 addDeviceListener state dpy device sys = do
-  rule <- matchBTProperty sys device
-  forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) sys
+  withBTPropertyRule sys device procMatch devInterface devConnected
   where
-    procMatch = withSignalMatch $ \c -> updateDevice state device c >> dpy
-
-matchConnected :: [Variant] -> SignalMatch Bool
-matchConnected = matchPropertyChanged devInterface devConnected
+    procMatch c = updateDevice state device c >> dpy
 
 callGetConnected
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)

From 29486107857f600585f49c9a52fa71e71a36fb85 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 21:36:16 -0500
Subject: [PATCH 085/118] ADD error message for device init

---
 lib/Xmobar/Plugins/Bluetooth.hs | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index e5acde8..c5eeb26 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -206,7 +206,12 @@ addDeviceRemovedListener state dpy adapter sys =
       old <- removeDevice state d
       forM_ old $ liftIO . removeMatch (toClient sys) . btDevSigHandler
 
-pathCallback :: MonadUnliftIO m => ObjectPath -> m () -> (ObjectPath -> m ()) -> SignalCallback m
+pathCallback
+  :: MonadUnliftIO m
+  => ObjectPath
+  -> m ()
+  -> (ObjectPath -> m ())
+  -> SignalCallback m
 pathCallback adapter dpy f [device, _] = forM_ (fromVariant device) $ \d ->
   when (adaptorHasDevice adapter d) $ f d >> dpy
 pathCallback _ _ _ _ = return ()
@@ -303,9 +308,12 @@ addAndInitDevice
   -> SysClient
   -> m ()
 addAndInitDevice state dpy device client = do
-  sh <- addDeviceListener state dpy device client
-  -- TODO add some intelligent error messages here
-  forM_ sh $ \s -> initDevice state s device client
+  res <- addDeviceListener state dpy device client
+  case res of
+    Just handler -> initDevice state handler device client
+    Nothing -> logError $ "could not initialize device at path " <> device_
+  where
+    device_ = displayWrapQuote $ displayObjectPath device
 
 initDevice
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)

From cc094bb0710677a7e526146b691b05b85bad49fa Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 22:03:17 -0500
Subject: [PATCH 086/118] ADD logging for device init

---
 lib/Xmobar/Plugins/Bluetooth.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index c5eeb26..454401c 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -78,6 +78,7 @@ startAdapter is cs cb cl = do
   ot <- getBtObjectTree cl
   state <- newMVar emptyState
   let dpy = displayIcon cb (iconFormatter is cs) state
+  -- TODO if this fails it won't be logged
   forM_ (findAdapter ot) $ \adapter -> do
     -- set up adapter
     initAdapter state adapter cl
@@ -227,9 +228,12 @@ initAdapter
   -> m ()
 initAdapter state adapter client = do
   reply <- callGetPowered adapter client
+  logInfo $ "initializing adapter at path " <> adapter_
   -- TODO this could fail if the variant is something weird; the only
   -- indication I will get is "NA"
   putPowered state $ fromSingletonVariant reply
+  where
+    adapter_ = displayWrapQuote $ displayObjectPath adapter
 
 matchBTProperty
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
@@ -310,7 +314,9 @@ addAndInitDevice
 addAndInitDevice state dpy device client = do
   res <- addDeviceListener state dpy device client
   case res of
-    Just handler -> initDevice state handler device client
+    Just handler -> do
+      logInfo $ "initializing device at path " <> device_
+      initDevice state handler device client
     Nothing -> logError $ "could not initialize device at path " <> device_
   where
     device_ = displayWrapQuote $ displayObjectPath device

From 69ed4839da965c1a31c4a0cd287bbd996dac0247 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 22:29:29 -0500
Subject: [PATCH 087/118] ENH use plugin name in xmobar loggers

---
 lib/Xmobar/Plugins/BacklightCommon.hs |  7 ++++---
 lib/Xmobar/Plugins/Bluetooth.hs       |  2 +-
 lib/Xmobar/Plugins/ClevoKeyboard.hs   |  2 +-
 lib/Xmobar/Plugins/Common.hs          |  9 ++++++++-
 lib/Xmobar/Plugins/Device.hs          |  5 +++--
 lib/Xmobar/Plugins/IntelBacklight.hs  |  2 +-
 lib/Xmobar/Plugins/Screensaver.hs     | 10 +++++-----
 lib/Xmobar/Plugins/VPN.hs             |  2 +-
 8 files changed, 24 insertions(+), 15 deletions(-)

diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs
index 7605953..14c8e4c 100644
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@@ -13,13 +13,14 @@ import Xmobar.Plugins.Common
 
 startBacklight
   :: (MonadUnliftIO m, RealFrac a)
-  => ((Maybe a -> RIO SimpleApp ()) -> SesClient -> RIO SimpleApp ())
+  => Utf8Builder
+  -> ((Maybe a -> RIO SimpleApp ()) -> SesClient -> RIO SimpleApp ())
   -> (SesClient -> RIO SimpleApp (Maybe a))
   -> T.Text
   -> Callback
   -> m ()
-startBacklight matchSignal callGetBrightness icon cb = do
-  withDBusClientConnection cb $ \c -> do
+startBacklight name matchSignal callGetBrightness icon cb = do
+  withDBusClientConnection cb name $ \c -> do
     matchSignal dpy c
     dpy =<< callGetBrightness c
   where
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 454401c..6f3c0c2 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -65,7 +65,7 @@ data Bluetooth = Bluetooth Icons Colors deriving (Read, Show)
 instance Exec Bluetooth where
   alias (Bluetooth _ _) = T.unpack btAlias
   start (Bluetooth icons colors) cb =
-    withDBusClientConnection cb $ startAdapter icons colors cb
+    withDBusClientConnection cb "bluetooth" $ startAdapter icons colors cb
 
 startAdapter
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
diff --git a/lib/Xmobar/Plugins/ClevoKeyboard.hs b/lib/Xmobar/Plugins/ClevoKeyboard.hs
index 3f98f34..7c0f99f 100644
--- a/lib/Xmobar/Plugins/ClevoKeyboard.hs
+++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs
@@ -25,4 +25,4 @@ ckAlias = "clevokeyboard"
 instance Exec ClevoKeyboard where
   alias (ClevoKeyboard _) = T.unpack ckAlias
   start (ClevoKeyboard icon) =
-    startBacklight matchSignalCK callGetBrightnessCK icon
+    startBacklight "clevo keyboard" matchSignalCK callGetBrightnessCK icon
diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs
index 1983bba..aaabde7 100644
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@@ -70,6 +70,13 @@ displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na)
 withDBusClientConnection
   :: (MonadUnliftIO m, SafeClient c)
   => Callback
+  -> Utf8Builder
   -> (c -> RIO SimpleApp ())
   -> m ()
-withDBusClientConnection cb f = runSimpleApp $ displayMaybe' cb f =<< getDBusClient
+withDBusClientConnection cb name f = do
+  logOpts <- setLogVerboseFormat True . setLogUseTime True . setLogFormat pre <$> logOptionsHandle stderr False
+  withLogFunc logOpts $ \lf -> do
+    env <- mkSimpleApp lf Nothing
+    runRIO env $ displayMaybe' cb f =<< getDBusClient
+  where
+    pre rest = "[" <> name <> " plugin] " <> rest
diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index 220a297..9a81261 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -67,11 +67,12 @@ matchStatus = matchPropertyChanged nmDeviceInterface devSignal
 
 instance Exec Device where
   alias (Device (iface, _, _)) = T.unpack iface
-  start (Device (iface, text, colors)) cb = do
-    withDBusClientConnection cb $ \sys -> do
+  start (Device (iface, text, colors)) cb =
+    withDBusClientConnection cb logName $ \sys -> do
       path <- getDevice sys iface
       displayMaybe' cb (listener sys) path
     where
+      logName = "device@" <> Utf8Builder (encodeUtf8Builder iface)
       listener sys path = do
         rule <- matchPropertyFull sys networkManagerBus (Just path)
         -- TODO warn the user here rather than silently drop the listener
diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs
index a4a777a..6174fba 100644
--- a/lib/Xmobar/Plugins/IntelBacklight.hs
+++ b/lib/Xmobar/Plugins/IntelBacklight.hs
@@ -25,4 +25,4 @@ blAlias = "intelbacklight"
 instance Exec IntelBacklight where
   alias (IntelBacklight _) = T.unpack blAlias
   start (IntelBacklight icon) =
-    startBacklight matchSignalIB callGetBrightnessIB icon
+    startBacklight "intel backlight" matchSignalIB callGetBrightnessIB icon
diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs
index 70fa3c1..8c333b7 100644
--- a/lib/Xmobar/Plugins/Screensaver.hs
+++ b/lib/Xmobar/Plugins/Screensaver.hs
@@ -24,9 +24,9 @@ ssAlias = "screensaver"
 
 instance Exec Screensaver where
   alias (Screensaver _) = T.unpack ssAlias
-  start (Screensaver (text, colors)) cb = do
-    withDBusClientConnection cb $ \sys -> do
-      matchSignal display sys
-      display =<< callQuery sys
+  start (Screensaver (text, colors)) cb =
+    withDBusClientConnection cb "screensaver" $ \sys -> do
+      matchSignal dpy sys
+      dpy =<< callQuery sys
     where
-      display = displayMaybe cb $ return . (\s -> colorText colors s text)
+      dpy = displayMaybe cb $ return . (\s -> colorText colors s text)
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index 0de5391..9cc3f5a 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -31,7 +31,7 @@ newtype VPN = VPN (T.Text, Colors) deriving (Read, Show)
 instance Exec VPN where
   alias (VPN _) = T.unpack vpnAlias
   start (VPN (text, colors)) cb =
-    withDBusClientConnection cb $ \c -> do
+    withDBusClientConnection cb "VPN" $ \c -> do
       state <- initState c
       let dpy = displayMaybe cb iconFormatter . Just =<< readState state
       let signalCallback' f = f state dpy

From 9d7ca49357a0f25af16af3bb13b43d63836487e4 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 22:40:28 -0500
Subject: [PATCH 088/118] ADD logger for device listener

---
 lib/Xmobar/Plugins/Device.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index 9a81261..3ce53fc 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -74,8 +74,8 @@ instance Exec Device where
     where
       logName = "device@" <> Utf8Builder (encodeUtf8Builder iface)
       listener sys path = do
-        rule <- matchPropertyFull sys networkManagerBus (Just path)
-        -- TODO warn the user here rather than silently drop the listener
-        forM_ rule $ \r ->
-          startListener r (getDeviceConnected path) matchStatus chooseColor' cb sys
+        res <- matchPropertyFull sys networkManagerBus (Just path)
+        case res of
+          Just rule -> startListener rule (getDeviceConnected path) matchStatus chooseColor' cb sys
+          Nothing -> logError "could not start listener"
       chooseColor' = return . (\s -> colorText colors s text) . (> 1)

From 37f607d817abe03299fb04bfc2d99124145527cb Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 23:03:31 -0500
Subject: [PATCH 089/118] REF use submonad for bluetooth state

---
 lib/Xmobar/Plugins/Bluetooth.hs | 201 +++++++++++++-------------------
 1 file changed, 84 insertions(+), 117 deletions(-)

diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 6f3c0c2..0436b61 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -68,28 +68,30 @@ instance Exec Bluetooth where
     withDBusClientConnection cb "bluetooth" $ startAdapter icons colors cb
 
 startAdapter
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Icons
+  :: Icons
   -> Colors
   -> Callback
   -> SysClient
-  -> m ()
+  -> RIO SimpleApp ()
 startAdapter is cs cb cl = do
-  ot <- getBtObjectTree cl
   state <- newMVar emptyState
-  let dpy = displayIcon cb (iconFormatter is cs) state
-  -- TODO if this fails it won't be logged
-  forM_ (findAdapter ot) $ \adapter -> do
-    -- set up adapter
-    initAdapter state adapter cl
-    void $ addAdaptorListener state dpy adapter cl
-    -- set up devices on the adapter (and listeners for adding/removing devices)
-    let devices = findDevices adapter ot
-    addDeviceAddedListener state dpy adapter cl
-    addDeviceRemovedListener state dpy adapter cl
-    forM_ devices $ \d -> addAndInitDevice state dpy d cl
-    -- after setting things up, show the icon based on the initialized state
-    dpy
+  let dpy = displayIcon cb (iconFormatter is cs)
+  mapRIO (wrap state) $ do
+    ot <- getBtObjectTree cl
+    -- TODO if this fails it won't be logged
+    forM_ (findAdapter ot) $ \adapter -> do
+      -- set up adapter
+      initAdapter adapter cl
+      void $ addAdaptorListener dpy adapter cl
+      -- set up devices on the adapter (and listeners for adding/removing devices)
+      let devices = findDevices adapter ot
+      addDeviceAddedListener dpy adapter cl
+      addDeviceRemovedListener dpy adapter cl
+      forM_ devices $ \d -> addAndInitDevice dpy d cl
+      -- after setting things up, show the icon based on the initialized state
+      dpy
+  where
+    wrap s env = BTEnv {btEnv = env, btState = s}
 
 --------------------------------------------------------------------------------
 -- Icon Display
@@ -101,9 +103,9 @@ type IconFormatter = (Maybe Bool -> Bool -> T.Text)
 
 type Icons = (T.Text, T.Text)
 
-displayIcon :: MonadUnliftIO m => Callback -> IconFormatter -> MutableBtState -> m ()
+displayIcon :: Callback -> IconFormatter -> BTIO ()
 displayIcon callback formatter =
-  liftIO . callback . T.unpack . uncurry formatter <=< readState
+  liftIO . callback . T.unpack . uncurry formatter =<< readState
 
 -- TODO maybe I want this to fail when any of the device statuses are Nothing
 iconFormatter :: Icons -> Colors -> IconFormatter
@@ -120,6 +122,16 @@ iconFormatter (iconConn, iconDisc) cs powered connected =
 -- is to track the shared state of the bluetooth adaptor and its devices using
 -- an MVar.
 
+data BTEnv = BTEnv
+  { btEnv :: !SimpleApp
+  , btState :: !(MVar BtState)
+  }
+
+instance HasLogFunc BTEnv where
+  logFuncL = lens btEnv (\x y -> x {btEnv = y}) . logFuncL
+
+type BTIO = RIO BTEnv
+
 data BTDevice = BTDevice
   { btDevConnected :: Maybe Bool
   , btDevSigHandler :: SignalHandler
@@ -132,8 +144,6 @@ data BtState = BtState
   , btPowered :: Maybe Bool
   }
 
-type MutableBtState = MVar BtState
-
 emptyState :: BtState
 emptyState =
   BtState
@@ -141,10 +151,10 @@ emptyState =
     , btPowered = Nothing
     }
 
-readState :: MonadUnliftIO m => MutableBtState -> m (Maybe Bool, Bool)
-readState state = do
-  p <- readPowered state
-  c <- readDevices state
+readState :: BTIO (Maybe Bool, Bool)
+readState = do
+  p <- readPowered
+  c <- readDevices
   return (p, anyDevicesConnected c)
 
 --------------------------------------------------------------------------------
@@ -180,31 +190,19 @@ addBtOMListener
   -> m ()
 addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
 
-addDeviceAddedListener
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => MutableBtState
-  -> m ()
-  -> ObjectPath
-  -> SysClient
-  -> m ()
-addDeviceAddedListener state dpy adapter client =
+addDeviceAddedListener :: BTIO () -> ObjectPath -> SysClient -> BTIO ()
+addDeviceAddedListener dpy adapter client =
   addBtOMListener addDevice client
   where
     addDevice = pathCallback adapter dpy $ \d ->
-      addAndInitDevice state dpy d client
+      addAndInitDevice dpy d client
 
-addDeviceRemovedListener
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => MutableBtState
-  -> m ()
-  -> ObjectPath
-  -> SysClient
-  -> m ()
-addDeviceRemovedListener state dpy adapter sys =
+addDeviceRemovedListener :: BTIO () -> ObjectPath -> SysClient -> BTIO ()
+addDeviceRemovedListener dpy adapter sys =
   addBtOMListener remDevice sys
   where
     remDevice = pathCallback adapter dpy $ \d -> do
-      old <- removeDevice state d
+      old <- removeDevice d
       forM_ old $ liftIO . removeMatch (toClient sys) . btDevSigHandler
 
 pathCallback
@@ -220,18 +218,13 @@ pathCallback _ _ _ _ = return ()
 --------------------------------------------------------------------------------
 -- Adapter
 
-initAdapter
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => MutableBtState
-  -> ObjectPath
-  -> SysClient
-  -> m ()
-initAdapter state adapter client = do
+initAdapter :: ObjectPath -> SysClient -> BTIO ()
+initAdapter adapter client = do
   reply <- callGetPowered adapter client
   logInfo $ "initializing adapter at path " <> adapter_
   -- TODO this could fail if the variant is something weird; the only
   -- indication I will get is "NA"
-  putPowered state $ fromSingletonVariant reply
+  putPowered $ fromSingletonVariant reply
   where
     adapter_ = displayWrapQuote $ displayObjectPath adapter
 
@@ -268,16 +261,14 @@ withBTPropertyRule cl path update iface prop = do
     matchConnected = matchPropertyChanged iface prop
 
 addAdaptorListener
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => MutableBtState
-  -> m ()
+  :: BTIO ()
   -> ObjectPath
   -> SysClient
-  -> m (Maybe SignalHandler)
-addAdaptorListener state dpy adaptor sys = do
+  -> BTIO (Maybe SignalHandler)
+addAdaptorListener dpy adaptor sys = do
   withBTPropertyRule sys adaptor procMatch adapterInterface adaptorPowered
   where
-    procMatch b = putPowered state b >> dpy
+    procMatch b = putPowered b >> dpy
 
 callGetPowered
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
@@ -289,11 +280,13 @@ callGetPowered adapter =
     memberName_ $
       T.unpack adaptorPowered
 
-putPowered :: MonadUnliftIO m => MutableBtState -> Maybe Bool -> m ()
-putPowered m ds = modifyMVar_ m (\s -> return s {btPowered = ds})
+putPowered :: Maybe Bool -> BTIO ()
+putPowered ds = do
+  m <- asks btState
+  modifyMVar_ m (\s -> return s {btPowered = ds})
 
-readPowered :: MonadUnliftIO m => MutableBtState -> m (Maybe Bool)
-readPowered = fmap btPowered . readMVar
+readPowered :: BTIO (Maybe Bool)
+readPowered = fmap btPowered $ readMVar =<< asks btState
 
 adapterInterface :: InterfaceName
 adapterInterface = interfaceName_ "org.bluez.Adapter1"
@@ -304,50 +297,32 @@ adaptorPowered = "Powered"
 --------------------------------------------------------------------------------
 -- Devices
 
-addAndInitDevice
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => MutableBtState
-  -> m ()
-  -> ObjectPath
-  -> SysClient
-  -> m ()
-addAndInitDevice state dpy device client = do
-  res <- addDeviceListener state dpy device client
+addAndInitDevice :: BTIO () -> ObjectPath -> SysClient -> BTIO ()
+addAndInitDevice dpy device client = do
+  res <- addDeviceListener dpy device client
   case res of
     Just handler -> do
       logInfo $ "initializing device at path " <> device_
-      initDevice state handler device client
+      initDevice handler device client
     Nothing -> logError $ "could not initialize device at path " <> device_
   where
     device_ = displayWrapQuote $ displayObjectPath device
 
-initDevice
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => MutableBtState
-  -> SignalHandler
-  -> ObjectPath
-  -> SysClient
-  -> m ()
-initDevice state sh device sys = do
+initDevice :: SignalHandler -> ObjectPath -> SysClient -> BTIO ()
+initDevice sh device sys = do
   reply <- callGetConnected device sys
   void $
-    insertDevice state device $
+    insertDevice device $
       BTDevice
         { btDevConnected = fromVariant =<< listToMaybe reply
         , btDevSigHandler = sh
         }
 
-addDeviceListener
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => MutableBtState
-  -> m ()
-  -> ObjectPath
-  -> SysClient
-  -> m (Maybe SignalHandler)
-addDeviceListener state dpy device sys = do
+addDeviceListener :: BTIO () -> ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
+addDeviceListener dpy device sys = do
   withBTPropertyRule sys device procMatch devInterface devConnected
   where
-    procMatch c = updateDevice state device c >> dpy
+    procMatch c = updateDevice device c >> dpy
 
 callGetConnected
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
@@ -358,40 +333,32 @@ callGetConnected p =
   callPropertyGet btBus p devInterface $
     memberName_ (T.unpack devConnected)
 
-insertDevice
-  :: MonadUnliftIO m
-  => MutableBtState
-  -> ObjectPath
-  -> BTDevice
-  -> m Bool
-insertDevice m device dev = modifyMVar m $ \s -> do
-  let new = M.insert device dev $ btDevices s
-  return (s {btDevices = new}, anyDevicesConnected new)
+insertDevice :: ObjectPath -> BTDevice -> BTIO Bool
+insertDevice device dev = do
+  m <- asks btState
+  modifyMVar m $ \s -> do
+    let new = M.insert device dev $ btDevices s
+    return (s {btDevices = new}, anyDevicesConnected new)
 
-updateDevice
-  :: MonadUnliftIO m
-  => MutableBtState
-  -> ObjectPath
-  -> Maybe Bool
-  -> m Bool
-updateDevice m device status = modifyMVar m $ \s -> do
-  let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s
-  return (s {btDevices = new}, anyDevicesConnected new)
+updateDevice :: ObjectPath -> Maybe Bool -> BTIO Bool
+updateDevice device status = do
+  m <- asks btState
+  modifyMVar m $ \s -> do
+    let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s
+    return (s {btDevices = new}, anyDevicesConnected new)
 
 anyDevicesConnected :: ConnectedDevices -> Bool
 anyDevicesConnected = or . mapMaybe btDevConnected . M.elems
 
-removeDevice
-  :: MonadUnliftIO m
-  => MutableBtState
-  -> ObjectPath
-  -> m (Maybe BTDevice)
-removeDevice m device = modifyMVar m $ \s -> do
-  let devs = btDevices s
-  return (s {btDevices = M.delete device devs}, M.lookup device devs)
+removeDevice :: ObjectPath -> BTIO (Maybe BTDevice)
+removeDevice device = do
+  m <- asks btState
+  modifyMVar m $ \s -> do
+    let devs = btDevices s
+    return (s {btDevices = M.delete device devs}, M.lookup device devs)
 
-readDevices :: MonadUnliftIO m => MutableBtState -> m ConnectedDevices
-readDevices = fmap btDevices . readMVar
+readDevices :: BTIO ConnectedDevices
+readDevices = fmap btDevices $ readMVar =<< asks btState
 
 devInterface :: InterfaceName
 devInterface = interfaceName_ "org.bluez.Device1"

From 097e4e19fc9f06fbc6cffb2ecf9074d72193eb41 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 23:09:23 -0500
Subject: [PATCH 090/118] REF clean up state functions in bluetooth

---
 lib/Xmobar/Plugins/Bluetooth.hs | 33 +++++++++++++++------------------
 1 file changed, 15 insertions(+), 18 deletions(-)

diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 0436b61..805713b 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -157,6 +157,11 @@ readState = do
   c <- readDevices
   return (p, anyDevicesConnected c)
 
+modifyState :: (BtState -> BTIO (BtState, a)) -> BTIO a
+modifyState f = do
+  m <- asks btState
+  modifyMVar m f
+
 --------------------------------------------------------------------------------
 -- Object manager
 
@@ -281,9 +286,7 @@ callGetPowered adapter =
       T.unpack adaptorPowered
 
 putPowered :: Maybe Bool -> BTIO ()
-putPowered ds = do
-  m <- asks btState
-  modifyMVar_ m (\s -> return s {btPowered = ds})
+putPowered ds = modifyState $ \s -> return (s {btPowered = ds}, ())
 
 readPowered :: BTIO (Maybe Bool)
 readPowered = fmap btPowered $ readMVar =<< asks btState
@@ -334,28 +337,22 @@ callGetConnected p =
     memberName_ (T.unpack devConnected)
 
 insertDevice :: ObjectPath -> BTDevice -> BTIO Bool
-insertDevice device dev = do
-  m <- asks btState
-  modifyMVar m $ \s -> do
-    let new = M.insert device dev $ btDevices s
-    return (s {btDevices = new}, anyDevicesConnected new)
+insertDevice device dev = modifyState $ \s -> do
+  let new = M.insert device dev $ btDevices s
+  return (s {btDevices = new}, anyDevicesConnected new)
 
 updateDevice :: ObjectPath -> Maybe Bool -> BTIO Bool
-updateDevice device status = do
-  m <- asks btState
-  modifyMVar m $ \s -> do
-    let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s
-    return (s {btDevices = new}, anyDevicesConnected new)
+updateDevice device status = modifyState $ \s -> do
+  let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s
+  return (s {btDevices = new}, anyDevicesConnected new)
 
 anyDevicesConnected :: ConnectedDevices -> Bool
 anyDevicesConnected = or . mapMaybe btDevConnected . M.elems
 
 removeDevice :: ObjectPath -> BTIO (Maybe BTDevice)
-removeDevice device = do
-  m <- asks btState
-  modifyMVar m $ \s -> do
-    let devs = btDevices s
-    return (s {btDevices = M.delete device devs}, M.lookup device devs)
+removeDevice device = modifyState $ \s -> do
+  let devs = btDevices s
+  return (s {btDevices = M.delete device devs}, M.lookup device devs)
 
 readDevices :: BTIO ConnectedDevices
 readDevices = fmap btDevices $ readMVar =<< asks btState

From c29a43a024d778364ee14973fdc27b6a8c2bcf8f Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 23:20:15 -0500
Subject: [PATCH 091/118] ENH log when bluetooth adapter not found

---
 lib/Xmobar/Plugins/Bluetooth.hs | 87 +++++++++++++++------------------
 1 file changed, 39 insertions(+), 48 deletions(-)

diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 805713b..23ad9f3 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -76,22 +76,21 @@ startAdapter
 startAdapter is cs cb cl = do
   state <- newMVar emptyState
   let dpy = displayIcon cb (iconFormatter is cs)
-  mapRIO (wrap state) $ do
+  mapRIO (BTEnv state dpy) $ do
     ot <- getBtObjectTree cl
-    -- TODO if this fails it won't be logged
-    forM_ (findAdapter ot) $ \adapter -> do
-      -- set up adapter
-      initAdapter adapter cl
-      void $ addAdaptorListener dpy adapter cl
-      -- set up devices on the adapter (and listeners for adding/removing devices)
-      let devices = findDevices adapter ot
-      addDeviceAddedListener dpy adapter cl
-      addDeviceRemovedListener dpy adapter cl
-      forM_ devices $ \d -> addAndInitDevice dpy d cl
-      -- after setting things up, show the icon based on the initialized state
-      dpy
-  where
-    wrap s env = BTEnv {btEnv = env, btState = s}
+    case findAdapter ot of
+      Nothing -> logError "could not find bluetooth adapter"
+      Just adapter -> do
+        -- set up adapter
+        initAdapter adapter cl
+        void $ addAdaptorListener adapter cl
+        -- set up devices on the adapter (and listeners for adding/removing devices)
+        let devices = findDevices adapter ot
+        addDeviceAddedListener adapter cl
+        addDeviceRemovedListener adapter cl
+        forM_ devices $ \d -> addAndInitDevice d cl
+        -- after setting things up, show the icon based on the initialized state
+        dpy
 
 --------------------------------------------------------------------------------
 -- Icon Display
@@ -123,8 +122,9 @@ iconFormatter (iconConn, iconDisc) cs powered connected =
 -- an MVar.
 
 data BTEnv = BTEnv
-  { btEnv :: !SimpleApp
-  , btState :: !(MVar BtState)
+  { btState :: !(MVar BtState)
+  , btDisplay :: !(BTIO ())
+  , btEnv :: !SimpleApp
   }
 
 instance HasLogFunc BTEnv where
@@ -195,30 +195,25 @@ addBtOMListener
   -> m ()
 addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
 
-addDeviceAddedListener :: BTIO () -> ObjectPath -> SysClient -> BTIO ()
-addDeviceAddedListener dpy adapter client =
-  addBtOMListener addDevice client
+addDeviceAddedListener :: ObjectPath -> SysClient -> BTIO ()
+addDeviceAddedListener adapter client = addBtOMListener addDevice client
   where
-    addDevice = pathCallback adapter dpy $ \d ->
-      addAndInitDevice dpy d client
+    addDevice = pathCallback adapter $ \d ->
+      addAndInitDevice d client
 
-addDeviceRemovedListener :: BTIO () -> ObjectPath -> SysClient -> BTIO ()
-addDeviceRemovedListener dpy adapter sys =
+addDeviceRemovedListener :: ObjectPath -> SysClient -> BTIO ()
+addDeviceRemovedListener adapter sys =
   addBtOMListener remDevice sys
   where
-    remDevice = pathCallback adapter dpy $ \d -> do
+    remDevice = pathCallback adapter $ \d -> do
       old <- removeDevice d
       forM_ old $ liftIO . removeMatch (toClient sys) . btDevSigHandler
 
-pathCallback
-  :: MonadUnliftIO m
-  => ObjectPath
-  -> m ()
-  -> (ObjectPath -> m ())
-  -> SignalCallback m
-pathCallback adapter dpy f [device, _] = forM_ (fromVariant device) $ \d ->
+pathCallback :: ObjectPath -> (ObjectPath -> BTIO ()) -> SignalCallback BTIO
+pathCallback adapter f [device, _] = forM_ (fromVariant device) $ \d -> do
+  dpy <- asks btDisplay
   when (adaptorHasDevice adapter d) $ f d >> dpy
-pathCallback _ _ _ _ = return ()
+pathCallback _ _ _ = return ()
 
 --------------------------------------------------------------------------------
 -- Adapter
@@ -265,15 +260,11 @@ withBTPropertyRule cl path update iface prop = do
     signalToUpdate = withSignalMatch update
     matchConnected = matchPropertyChanged iface prop
 
-addAdaptorListener
-  :: BTIO ()
-  -> ObjectPath
-  -> SysClient
-  -> BTIO (Maybe SignalHandler)
-addAdaptorListener dpy adaptor sys = do
+addAdaptorListener :: ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
+addAdaptorListener adaptor sys = do
+  dpy <- asks btDisplay
+  let procMatch b = putPowered b >> dpy
   withBTPropertyRule sys adaptor procMatch adapterInterface adaptorPowered
-  where
-    procMatch b = putPowered b >> dpy
 
 callGetPowered
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
@@ -300,9 +291,9 @@ adaptorPowered = "Powered"
 --------------------------------------------------------------------------------
 -- Devices
 
-addAndInitDevice :: BTIO () -> ObjectPath -> SysClient -> BTIO ()
-addAndInitDevice dpy device client = do
-  res <- addDeviceListener dpy device client
+addAndInitDevice :: ObjectPath -> SysClient -> BTIO ()
+addAndInitDevice device client = do
+  res <- addDeviceListener device client
   case res of
     Just handler -> do
       logInfo $ "initializing device at path " <> device_
@@ -321,11 +312,11 @@ initDevice sh device sys = do
         , btDevSigHandler = sh
         }
 
-addDeviceListener :: BTIO () -> ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
-addDeviceListener dpy device sys = do
+addDeviceListener :: ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
+addDeviceListener device sys = do
+  dpy <- asks btDisplay
+  let procMatch c = updateDevice device c >> dpy
   withBTPropertyRule sys device procMatch devInterface devConnected
-  where
-    procMatch c = updateDevice device c >> dpy
 
 callGetConnected
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)

From 27b32fb03ee1b7fe9805660989b2e8b79535b664 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 10:33:04 -0500
Subject: [PATCH 092/118] ENH use rio for vpn

---
 lib/Xmobar/Plugins/Bluetooth.hs | 18 ++++----
 lib/Xmobar/Plugins/VPN.hs       | 74 +++++++++++++++++++--------------
 2 files changed, 53 insertions(+), 39 deletions(-)

diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 23ad9f3..ef70c68 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -162,6 +162,9 @@ modifyState f = do
   m <- asks btState
   modifyMVar m f
 
+beforeDisplay :: BTIO () -> BTIO ()
+beforeDisplay f = f >> join (asks btDisplay)
+
 --------------------------------------------------------------------------------
 -- Object manager
 
@@ -211,8 +214,7 @@ addDeviceRemovedListener adapter sys =
 
 pathCallback :: ObjectPath -> (ObjectPath -> BTIO ()) -> SignalCallback BTIO
 pathCallback adapter f [device, _] = forM_ (fromVariant device) $ \d -> do
-  dpy <- asks btDisplay
-  when (adaptorHasDevice adapter d) $ f d >> dpy
+  when (adaptorHasDevice adapter d) $ beforeDisplay $ f d
 pathCallback _ _ _ = return ()
 
 --------------------------------------------------------------------------------
@@ -261,10 +263,10 @@ withBTPropertyRule cl path update iface prop = do
     matchConnected = matchPropertyChanged iface prop
 
 addAdaptorListener :: ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
-addAdaptorListener adaptor sys = do
-  dpy <- asks btDisplay
-  let procMatch b = putPowered b >> dpy
+addAdaptorListener adaptor sys =
   withBTPropertyRule sys adaptor procMatch adapterInterface adaptorPowered
+  where
+    procMatch = beforeDisplay . putPowered
 
 callGetPowered
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
@@ -313,10 +315,10 @@ initDevice sh device sys = do
         }
 
 addDeviceListener :: ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
-addDeviceListener device sys = do
-  dpy <- asks btDisplay
-  let procMatch c = updateDevice device c >> dpy
+addDeviceListener device sys =
   withBTPropertyRule sys device procMatch devInterface devConnected
+  where
+    procMatch = beforeDisplay . void . updateDevice device
 
 callGetConnected
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index 9cc3f5a..b7b52df 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -33,11 +33,11 @@ instance Exec VPN where
   start (VPN (text, colors)) cb =
     withDBusClientConnection cb "VPN" $ \c -> do
       state <- initState c
-      let dpy = displayMaybe cb iconFormatter . Just =<< readState state
-      let signalCallback' f = f state dpy
-      vpnAddedListener (signalCallback' addedCallback) c
-      vpnRemovedListener (signalCallback' removedCallback) c
-      dpy
+      let dpy = displayMaybe cb iconFormatter . Just =<< readState
+      mapRIO (VEnv state dpy) $ do
+        vpnAddedListener addedCallback c
+        vpnRemovedListener removedCallback c
+        dpy
     where
       iconFormatter b = return $ colorText colors b text
 
@@ -48,6 +48,17 @@ instance Exec VPN where
 -- this will be a null or singleton set, but this setup could handle the edge
 -- case of multiple VPNs being active at once without puking.
 
+data VEnv = VEnv
+  { vState :: !MutableVPNState
+  , vDisplay :: !(VIO ())
+  , vEnv :: !SimpleApp
+  }
+
+instance HasLogFunc VEnv where
+  logFuncL = lens vEnv (\x y -> x {vEnv = y}) . logFuncL
+
+type VIO = RIO VEnv
+
 type VPNState = S.Set ObjectPath
 
 type MutableVPNState = MVar VPNState
@@ -60,16 +71,16 @@ initState client = do
   ot <- getVPNObjectTree client
   newMVar $ findTunnels ot
 
-readState :: MonadUnliftIO m => MutableVPNState -> m Bool
-readState = fmap (not . null) . readMVar
+readState :: VIO Bool
+readState = fmap (not . null) . readMVar =<< asks vState
 
-updateState
-  :: MonadUnliftIO m
-  => (ObjectPath -> VPNState -> VPNState)
-  -> MutableVPNState
-  -> ObjectPath
-  -> m ()
-updateState f state op = modifyMVar_ state $ return . f op
+updateState :: (ObjectPath -> VPNState -> VPNState) -> ObjectPath -> VIO ()
+updateState f op = do
+  s <- asks vState
+  modifyMVar_ s $ return . f op
+
+beforeDisplay :: VIO () -> VIO ()
+beforeDisplay f = f >> join (asks vDisplay)
 
 --------------------------------------------------------------------------------
 -- Tunnel Device Detection
@@ -97,32 +108,33 @@ vpnRemovedListener
   -> m ()
 vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
 
-addedCallback :: MonadUnliftIO m => MutableVPNState -> m () -> SignalCallback m
-addedCallback state dpy [device, added] = update >> dpy
+addedCallback :: SignalCallback VIO
+addedCallback [device, added] =
+  beforeDisplay $
+    updateDevice S.insert device $
+      M.keys $
+        fromMaybe M.empty added'
   where
     added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant))
-    is = M.keys $ fromMaybe M.empty added'
-    update = updateDevice S.insert state device is
-addedCallback _ _ _ = return ()
+addedCallback _ = return ()
 
-removedCallback :: MonadUnliftIO m => MutableVPNState -> m () -> SignalCallback m
-removedCallback state dpy [device, interfaces] = update >> dpy
-  where
-    is = fromMaybe [] $ fromVariant interfaces :: [T.Text]
-    update = updateDevice S.delete state device is
-removedCallback _ _ _ = return ()
+removedCallback :: SignalCallback VIO
+removedCallback [device, interfaces] =
+  beforeDisplay $
+    updateDevice S.delete device $
+      fromMaybe [] $
+        fromVariant interfaces
+removedCallback _ = return ()
 
 updateDevice
-  :: MonadUnliftIO m
-  => (ObjectPath -> VPNState -> VPNState)
-  -> MutableVPNState
+  :: (ObjectPath -> VPNState -> VPNState)
   -> Variant
   -> [T.Text]
-  -> m ()
-updateDevice f state device interfaces =
+  -> VIO ()
+updateDevice f device interfaces =
   when (vpnDeviceTun `elem` interfaces) $
     forM_ d $
-      updateState f state
+      updateState f
   where
     d = fromVariant device :: Maybe ObjectPath
 

From b64742b925015f7291642640c05efd6b09fc49fd Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 12:33:22 -0500
Subject: [PATCH 093/118] ENH make features more mappable

---
 lib/Data/Internal/XIO.hs | 26 ++++++++++++++++++--------
 1 file changed, 18 insertions(+), 8 deletions(-)

diff --git a/lib/Data/Internal/XIO.hs b/lib/Data/Internal/XIO.hs
index 27dfe29..61801af 100644
--- a/lib/Data/Internal/XIO.hs
+++ b/lib/Data/Internal/XIO.hs
@@ -221,12 +221,13 @@ type Feature a = Either (Sometimes a) (Always a)
 -- | Feature that is guaranteed to work
 -- This is composed of sub-features that are tested in order, and if all fail
 -- the fallback is a monadic action (eg a plain haskell function)
-data Always a = Always T.Text (Always_ a)
+data Always a = Always T.Text (Always_ a) deriving (Functor)
 
 -- | Feature that is guaranteed to work (inner data)
 data Always_ a
   = Option (SubfeatureRoot a) (Always_ a)
   | Always_ (FallbackRoot a)
+  deriving (Functor)
 
 -- | Root of a fallback action for an always
 -- This may either be a lone action or a function that depends on the results
@@ -235,15 +236,23 @@ data FallbackRoot a
   = FallbackAlone a
   | forall p. FallbackTree (p -> a) (FallbackStack p)
 
+instance Functor FallbackRoot where
+  fmap f (FallbackAlone a) = FallbackAlone (f a)
+  fmap f (FallbackTree g s) = FallbackTree (f . g) s
+
 -- | Always features that are used as a payload for a fallback action
 data FallbackStack p
   = FallbackBottom (Always p)
   | forall x y. FallbackStack (x -> y -> p) (Always x) (FallbackStack y)
 
+instance Functor FallbackStack where
+  fmap f (FallbackBottom a) = FallbackBottom $ fmap f a
+  fmap f (FallbackStack g a s) = FallbackStack (\x -> f . g x) a s
+
 -- | Feature that might not be present
 -- This is like an Always except it doesn't fall back on a guaranteed monadic
 -- action
-data Sometimes a = Sometimes T.Text XPQuery (Sometimes_ a)
+data Sometimes a = Sometimes T.Text XPQuery (Sometimes_ a) deriving (Functor)
 
 -- | Feature that might not be present (inner data)
 type Sometimes_ a = [SubfeatureRoot a]
@@ -256,6 +265,7 @@ data Subfeature f = Subfeature
   { sfData :: f
   , sfName :: T.Text
   }
+  deriving (Functor)
 
 type SubfeatureRoot a = Subfeature (Root a)
 
@@ -268,6 +278,12 @@ data Root a
   | forall c p. SafeClient c => DBusRoot (p -> c -> a) (DBusTree c p) (Maybe c)
   | forall c. SafeClient c => DBusRoot_ (c -> a) (DBusTree_ c) (Maybe c)
 
+instance Functor Root where
+  fmap f (IORoot a t) = IORoot (f . a) t
+  fmap f (IORoot_ a t) = IORoot_ (f a) t
+  fmap f (DBusRoot a t cl) = DBusRoot (\p c -> f $ a p c) t cl
+  fmap f (DBusRoot_ a t cl) = DBusRoot_ (f . a) t cl
+
 -- | The dependency tree with rule to merge results when needed
 data Tree d d_ p
   = forall x y. And12 (x -> y -> p) (Tree d d_ x) (Tree d d_ y)
@@ -927,12 +943,6 @@ testDBusDepNoCache_ _ (DBusIO i) = testIODepNoCache_ i
 -- ioSubfeature :: MonadIO m => SubfeatureRoot (IO a) -> SubfeatureRoot (m a)
 -- ioSubfeature sf = sf {sfData = ioRoot $ sfData sf}
 
--- ioRoot :: MonadIO m => Root (IO a) -> Root (m a)
--- ioRoot (IORoot a t) = IORoot (io . a) t
--- ioRoot (IORoot_ a t) = IORoot_ (io a) t
--- ioRoot (DBusRoot a t cl) = DBusRoot (\p c -> io $ a p c) t cl
--- ioRoot (DBusRoot_ a t cl) = DBusRoot_ (io . a) t cl
-
 --------------------------------------------------------------------------------
 -- Feature constructors
 

From 9ec24b63a0fdd34a33d88a3b8d9895f6a21d9ca6 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 12:33:37 -0500
Subject: [PATCH 094/118] ENH use rio in (one) interactive command

---
 bin/xmonad.hs                           | 12 ++++++------
 lib/XMonad/Internal/DBus/Screensaver.hs |  2 +-
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 2380e6d..e831bbd 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -123,7 +123,7 @@ run = do
           dws <- startDynWorkspaces fs
           runIO <- askRunInIO
           let cleanup = runCleanup runIO toClean db
-          kbs <- filterExternal <$> evalExternal (fsKeys fs cleanup db)
+          kbs <- filterExternal <$> evalExternal (fsKeys fs runIO cleanup db)
           sk <- evalAlways $ fsShowKeys fs
           ha <- evalAlways $ fsACPIHandler fs
           tt <- evalAlways $ fsTabbedTheme fs
@@ -171,7 +171,7 @@ getCreateDirectories = do
         _ -> return ()
 
 data FeatureSet = FeatureSet
-  { fsKeys :: X () -> DBusState -> [KeyGroup FeatureX]
+  { fsKeys :: (XIO () -> IO ()) -> X () -> DBusState -> [KeyGroup FeatureX]
   , fsDBusExporters :: [Maybe SesClient -> Sometimes (XIO (), XIO ())]
   , fsPowerMon :: SometimesIO
   , fsRemovableMon :: Maybe SysClient -> SometimesIO
@@ -262,7 +262,7 @@ printDeps = withDBus_ $ \db -> do
   let mockCleanup = runCleanup runIO mockClean db
   let bfs =
         concatMap (fmap kbMaybeAction . kgBindings) $
-          externalBindings mockCleanup db
+          externalBindings runIO mockCleanup db
   let dbus =
         fmap (\f -> f $ dbSesClient db) dbusExporters
           :: [Sometimes (XIO (), XIO ())]
@@ -794,8 +794,8 @@ filterExternal = fmap go
             ]
         }
 
-externalBindings :: X () -> DBusState -> [KeyGroup FeatureX]
-externalBindings cleanup db =
+externalBindings :: (XIO () -> IO ()) -> X () -> DBusState -> [KeyGroup FeatureX]
+externalBindings runIO cleanup db =
   [ KeyGroup
       "Launchers"
       [ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu
@@ -860,7 +860,7 @@ externalBindings cleanup db =
       , KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
       , KeyBinding "M-<F9>" "toggle ethernet" $ Left runToggleEthernet
       , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ runToggleBluetooth sys
-      , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ callToggle ses
+      , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ (liftIO . runIO) <$> callToggle ses
       , KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt
       ]
   ]
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index bb72129..96e1ca8 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -124,7 +124,7 @@ exportScreensaver ses =
     bus = Bus [] xmonadBusName
     ssx = DBusIO $ sysExe [Package Official "xorg-xset"] ssExecutable
 
-callToggle :: Maybe SesClient -> SometimesX
+callToggle :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 callToggle =
   sometimesEndpoint
     "screensaver toggle"

From c1fef3c4c405ad48b0a04ca1d31ca7c1cf18be0d Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 18:21:09 -0500
Subject: [PATCH 095/118] REF simplify

---
 bin/xmonad.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index e831bbd..9d1774f 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -860,7 +860,7 @@ externalBindings runIO cleanup db =
       , KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
       , KeyBinding "M-<F9>" "toggle ethernet" $ Left runToggleEthernet
       , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ runToggleBluetooth sys
-      , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ (liftIO . runIO) <$> callToggle ses
+      , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ liftIO . runIO <$> callToggle ses
       , KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt
       ]
   ]

From 8eb97f3eeccfdbe2ce11afd020b15eb586be1ee2 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 18:21:13 -0500
Subject: [PATCH 096/118] ENH use dbus lib for signals

---
 lib/XMonad/Internal/DBus/Removable.hs | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs
index ab58373..1a228c1 100644
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@@ -73,24 +73,23 @@ removedHasDrive [_, a] =
     (fromVariant a :: Maybe [String])
 removedHasDrive _ = False
 
-playSoundMaybe :: FilePath -> Bool -> IO ()
+playSoundMaybe :: MonadUnliftIO m => FilePath -> Bool -> m ()
 playSoundMaybe p b = when b $ io $ playSound p
 
 -- NOTE: the udisks2 service should be already running for this module to work.
 -- If it not already, we won't see any signals from the dbus until it is
 -- started (it will work after it is started however). It seems safe to simply
 -- enable the udisks2 service at boot; however this is not default behavior.
-listenDevices :: SysClient -> IO ()
+listenDevices :: MonadUnliftIO m => SysClient -> m ()
 listenDevices cl = do
   addMatch' memAdded driveInsertedSound addedHasDrive
   addMatch' memRemoved driveRemovedSound removedHasDrive
   where
-    addMatch' m p f =
-      void $
-        addMatch (toClient cl) ruleUdisks {matchMember = Just m} $
-          playSoundMaybe p . f . signalBody
+    addMatch' m p f = do
+      let rule = ruleUdisks {matchMember = Just m}
+      void $ addMatchCallback rule (playSoundMaybe p . f) cl
 
-runRemovableMon :: Maybe SysClient -> SometimesIO
+runRemovableMon :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
 runRemovableMon cl =
   sometimesDBus cl "removeable device monitor" "dbus monitor" deps $ io . listenDevices
   where

From 524818decf0b54d954f47110dee90e68bfb7db17 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 18:30:17 -0500
Subject: [PATCH 097/118] ENH generalize brightness controls

---
 bin/xmonad.hs                                 |  2 +-
 .../Internal/DBus/Brightness/ClevoKeyboard.hs |  2 +-
 lib/XMonad/Internal/DBus/Brightness/Common.hs | 20 ++++++++++---------
 .../DBus/Brightness/IntelBacklight.hs         |  2 +-
 4 files changed, 14 insertions(+), 12 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 9d1774f..488d2a0 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -867,7 +867,7 @@ externalBindings runIO cleanup db =
   where
     ses = dbSesClient db
     sys = dbSysClient db
-    brightessControls ctl getter = (getter . ctl) ses
+    brightessControls ctl getter = (fmap (liftIO . runIO) . getter . ctl) ses
     ib = Left . brightessControls intelBacklightControls
     ck = Left . brightessControls clevoKeyboardControls
     ftrAlways n = Right . Always n . Always_ . FallbackAlone
diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
index e2776d5..3564773 100644
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@@ -126,7 +126,7 @@ exportClevoKeyboard =
     [stateFileDep, brightnessFileDep]
     clevoKeyboardConfig
 
-clevoKeyboardControls :: Maybe SesClient -> BrightnessControls
+clevoKeyboardControls :: MonadUnliftIO m => Maybe SesClient -> BrightnessControls m
 clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
 
 callGetBrightnessCK :: MonadUnliftIO m => SesClient -> m (Maybe Brightness)
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 731c3b2..cbf0ca5 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -45,18 +45,19 @@ data BrightnessConfig a b = BrightnessConfig
   , bcName :: T.Text
   }
 
-data BrightnessControls = BrightnessControls
-  { bctlMax :: SometimesX
-  , bctlMin :: SometimesX
-  , bctlInc :: SometimesX
-  , bctlDec :: SometimesX
+data BrightnessControls m = BrightnessControls
+  { bctlMax :: Sometimes (m ())
+  , bctlMin :: Sometimes (m ())
+  , bctlInc :: Sometimes (m ())
+  , bctlDec :: Sometimes (m ())
   }
 
 brightnessControls
-  :: XPQuery
+  :: MonadUnliftIO m
+  => XPQuery
   -> BrightnessConfig a b
   -> Maybe SesClient
-  -> BrightnessControls
+  -> BrightnessControls m
 brightnessControls q bc cl =
   BrightnessControls
     { bctlMax = cb "max brightness" memMax
@@ -167,12 +168,13 @@ emitBrightness BrightnessConfig {bcPath = p, bcInterface = i} client cur =
     sig = signal p i memCur
 
 callBacklight
-  :: XPQuery
+  :: MonadUnliftIO m
+  => XPQuery
   -> Maybe SesClient
   -> BrightnessConfig a b
   -> T.Text
   -> MemberName
-  -> SometimesX
+  -> Sometimes (m ())
 callBacklight
   q
   cl
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index 7a4b89d..6e90376 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@@ -110,7 +110,7 @@ exportIntelBacklight =
     [curFileDep, maxFileDep]
     intelBacklightConfig
 
-intelBacklightControls :: Maybe SesClient -> BrightnessControls
+intelBacklightControls :: MonadUnliftIO m => Maybe SesClient -> BrightnessControls m
 intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig
 
 callGetBrightnessIB :: MonadUnliftIO m => SesClient -> m (Maybe Brightness)

From 6c23813693093d7eb56002a74ec09e3e606e2b47 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 19:15:12 -0500
Subject: [PATCH 098/118] REF don't derive generic unnecessarily

---
 lib/Data/Internal/XIO.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/lib/Data/Internal/XIO.hs b/lib/Data/Internal/XIO.hs
index 61801af..e3bf816 100644
--- a/lib/Data/Internal/XIO.hs
+++ b/lib/Data/Internal/XIO.hs
@@ -320,7 +320,6 @@ data DBusDependency_ c
   = Bus [Fulfillment] BusName
   | Endpoint [Fulfillment] BusName ObjectPath InterfaceName DBusMember
   | DBusIO IODependency_
-  deriving (Generic)
 
 -- | A dependency that only requires IO to evaluate (no payload)
 data IODependency_
@@ -335,23 +334,23 @@ data SystemDependency
   | AccessiblePath FilePath Bool Bool
   | Systemd UnitType T.Text
   | Process T.Text
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 -- | The type of a systemd service
-data UnitType = SystemUnit | UserUnit deriving (Eq, Show, Generic)
+data UnitType = SystemUnit | UserUnit deriving (Eq, Show)
 
 -- | Wrapper type to describe and endpoint
 data DBusMember
   = Method_ MemberName
   | Signal_ MemberName
   | Property_ T.Text
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 -- | A means to fulfill a dependency
 -- For now this is just the name of an Arch Linux package (AUR or official)
 data Fulfillment = Package ArchPkg T.Text deriving (Eq, Show, Ord)
 
-data ArchPkg = Official | AUR | Custom deriving (Eq, Show, Generic, Ord)
+data ArchPkg = Official | AUR | Custom deriving (Eq, Show, Ord)
 
 --------------------------------------------------------------------------------
 -- Tested dependency tree

From db7011bfd81b9dafb96ee3f8ec8d8594c8638739 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 19:15:25 -0500
Subject: [PATCH 099/118] ENH generalize brightness exporters

---
 .../Internal/DBus/Brightness/ClevoKeyboard.hs | 22 ++++----
 lib/XMonad/Internal/DBus/Brightness/Common.hs | 50 +++++++++----------
 .../DBus/Brightness/IntelBacklight.hs         | 20 +++++---
 3 files changed, 48 insertions(+), 44 deletions(-)

diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
index 3564773..7495da2 100644
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@@ -46,34 +46,34 @@ backlightDir = "/sys/devices/platform/tuxedo_keyboard"
 stateFile :: FilePath
 stateFile = backlightDir </> "state"
 
-stateChange :: Bool -> IO ()
+stateChange :: MonadUnliftIO m => Bool -> m ()
 stateChange = writeBool stateFile
 
-stateOn :: IO ()
+stateOn :: MonadUnliftIO m => m ()
 stateOn = stateChange True
 
-stateOff :: IO ()
+stateOff :: MonadUnliftIO m => m ()
 stateOff = stateChange False
 
 brightnessFile :: FilePath
 brightnessFile = backlightDir </> "brightness"
 
-getBrightness :: RawBounds -> IO Brightness
+getBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
 getBrightness bounds = readPercent bounds brightnessFile
 
-minBrightness :: RawBounds -> IO Brightness
+minBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
 minBrightness bounds = do
   b <- writePercentMin bounds brightnessFile
   stateOff
   return b
 
-maxBrightness :: RawBounds -> IO Brightness
+maxBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
 maxBrightness bounds = stateOn >> writePercentMax bounds brightnessFile
 
-incBrightness :: RawBounds -> IO Brightness
+incBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
 incBrightness bounds = stateOn >> incPercent steps brightnessFile bounds
 
-decBrightness :: RawBounds -> IO Brightness
+decBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
 decBrightness bounds = do
   b <- decPercent steps brightnessFile bounds
   when (b == 0) stateOff
@@ -88,7 +88,7 @@ blPath = objectPath_ "/clevo_keyboard"
 interface :: InterfaceName
 interface = interfaceName_ "org.xmonad.Brightness"
 
-clevoKeyboardConfig :: BrightnessConfig RawBrightness Brightness
+clevoKeyboardConfig :: MonadUnliftIO m => BrightnessConfig m RawBrightness Brightness
 clevoKeyboardConfig =
   BrightnessConfig
     { bcMin = minBrightness
@@ -113,7 +113,9 @@ brightnessFileDep :: IODependency_
 brightnessFileDep = pathR brightnessFile [Package AUR "tuxedo-keyboard"]
 
 clevoKeyboardSignalDep :: DBusDependency_ SesClient
-clevoKeyboardSignalDep = signalDep clevoKeyboardConfig
+clevoKeyboardSignalDep =
+  -- TODO do I need to get rid of the IO here?
+  signalDep (clevoKeyboardConfig :: BrightnessConfig IO RawBrightness Brightness)
 
 exportClevoKeyboard
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index cbf0ca5..4ef5e9d 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 
 --------------------------------------------------------------------------------
 -- DBus module for DBus brightness controls
@@ -32,14 +33,14 @@ import XMonad.Internal.DBus.Common
 -- integer and emit a signal with the same brightness value. Additionally, there
 -- is one method to get the current brightness.
 
-data BrightnessConfig a b = BrightnessConfig
-  { bcMin :: (a, a) -> IO b
-  , bcMax :: (a, a) -> IO b
-  , bcDec :: (a, a) -> IO b
-  , bcInc :: (a, a) -> IO b
-  , bcGet :: (a, a) -> IO b
+data BrightnessConfig m a b = BrightnessConfig
+  { bcMin :: (a, a) -> m b
+  , bcMax :: (a, a) -> m b
+  , bcDec :: (a, a) -> m b
+  , bcInc :: (a, a) -> m b
+  , bcGet :: (a, a) -> m b
   , bcMinRaw :: a
-  , bcGetMax :: IO a
+  , bcGetMax :: m a
   , bcPath :: ObjectPath
   , bcInterface :: InterfaceName
   , bcName :: T.Text
@@ -55,7 +56,7 @@ data BrightnessControls m = BrightnessControls
 brightnessControls
   :: MonadUnliftIO m
   => XPQuery
-  -> BrightnessConfig a b
+  -> BrightnessConfig m a b
   -> Maybe SesClient
   -> BrightnessControls m
 brightnessControls q bc cl =
@@ -70,20 +71,20 @@ brightnessControls q bc cl =
 
 callGetBrightness
   :: (MonadUnliftIO m, SafeClient c, Num n)
-  => BrightnessConfig a b
+  => BrightnessConfig m a b
   -> c
   -> m (Maybe n)
 callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} client =
   either (const Nothing) bodyGetBrightness
     <$> callMethod client xmonadBusName p i memGet
 
-signalDep :: BrightnessConfig a b -> DBusDependency_ SesClient
+signalDep :: BrightnessConfig m a b -> DBusDependency_ SesClient
 signalDep BrightnessConfig {bcPath = p, bcInterface = i} =
   Endpoint [] xmonadBusName p i $ Signal_ memCur
 
 matchSignal
   :: (MonadUnliftIO m, SafeClient c, Num n)
-  => BrightnessConfig a b
+  => BrightnessConfig m a b
   -> (Maybe n -> m ())
   -> c
   -> m ()
@@ -106,7 +107,7 @@ brightnessExporter
   => XPQuery
   -> [Fulfillment]
   -> [IODependency_]
-  -> BrightnessConfig a b
+  -> BrightnessConfig m a b
   -> Maybe SesClient
   -> Sometimes (m (), m ())
 brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
@@ -117,21 +118,19 @@ brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
 
 exportBrightnessControlsInner
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, RealFrac b)
-  => BrightnessConfig a b
+  => BrightnessConfig m a b
   -> SesClient
   -> (m (), m ())
 exportBrightnessControlsInner bc = cmd
   where
     cmd = exportPair (bcPath bc) $ \cl_ -> do
-      -- up = liftIO $ do
-      -- let ses = toClient cl
-      maxval <- liftIO $ bcGetMax bc -- assume the max value will never change
-      let bounds = (bcMinRaw bc, maxval)
-      let autoMethod' m f = autoMethod m $ emitBrightness bc cl_ =<< f bc bounds
-      let funget = bcGet bc
-      -- export
-      --   ses
-      --   (bcPath bc)
+      -- assume the max value will never change
+      bounds <- (bcMinRaw bc,) <$> bcGetMax bc
+      runIO <- askRunInIO
+      let autoMethod' m f = autoMethod m $ runIO $ do
+            val <- f bc bounds
+            emitBrightness bc cl_ val
+      funget <- toIO $ bcGet bc bounds
       return $
         defaultInterface
           { interfaceName = bcInterface bc
@@ -140,11 +139,10 @@ exportBrightnessControlsInner bc = cmd
               , autoMethod' memMin bcMin
               , autoMethod' memInc bcInc
               , autoMethod' memDec bcDec
-              , autoMethod memGet (round <$> funget bounds :: IO Int32)
+              , autoMethod memGet (round <$> funget :: IO Int32)
               ]
           , interfaceSignals = [sig]
           }
-    -- down = liftIO $ unexport (toClient cl) (bcPath bc)
     sig =
       I.Signal
         { I.signalName = memCur
@@ -158,7 +156,7 @@ exportBrightnessControlsInner bc = cmd
 
 emitBrightness
   :: (MonadUnliftIO m, RealFrac b)
-  => BrightnessConfig a b
+  => BrightnessConfig m a b
   -> Client
   -> b
   -> m ()
@@ -171,7 +169,7 @@ callBacklight
   :: MonadUnliftIO m
   => XPQuery
   -> Maybe SesClient
-  -> BrightnessConfig a b
+  -> BrightnessConfig m a b
   -> T.Text
   -> MemberName
   -> Sometimes (m ())
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index 6e90376..b4ea2ec 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@@ -45,22 +45,22 @@ maxFile = backlightDir </> "max_brightness"
 curFile :: FilePath
 curFile = backlightDir </> "brightness"
 
-getMaxRawBrightness :: IO RawBrightness
+getMaxRawBrightness :: MonadUnliftIO m => m RawBrightness
 getMaxRawBrightness = readInt maxFile
 
-getBrightness :: RawBounds -> IO Brightness
+getBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
 getBrightness bounds = readPercent bounds curFile
 
-minBrightness :: RawBounds -> IO Brightness
+minBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
 minBrightness bounds = writePercentMin bounds curFile
 
-maxBrightness :: RawBounds -> IO Brightness
+maxBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
 maxBrightness bounds = writePercentMax bounds curFile
 
-incBrightness :: RawBounds -> IO Brightness
+incBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
 incBrightness = incPercent steps curFile
 
-decBrightness :: RawBounds -> IO Brightness
+decBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
 decBrightness = decPercent steps curFile
 
 --------------------------------------------------------------------------------
@@ -72,7 +72,9 @@ blPath = objectPath_ "/intelbacklight"
 interface :: InterfaceName
 interface = interfaceName_ "org.xmonad.Brightness"
 
-intelBacklightConfig :: BrightnessConfig RawBrightness Brightness
+intelBacklightConfig
+  :: MonadUnliftIO m
+  => BrightnessConfig m RawBrightness Brightness
 intelBacklightConfig =
   BrightnessConfig
     { bcMin = minBrightness
@@ -97,7 +99,9 @@ maxFileDep :: IODependency_
 maxFileDep = pathR maxFile []
 
 intelBacklightSignalDep :: DBusDependency_ SesClient
-intelBacklightSignalDep = signalDep intelBacklightConfig
+intelBacklightSignalDep =
+  -- TODO do I need to get rid of the IO here?
+  signalDep (intelBacklightConfig :: BrightnessConfig IO RawBrightness Brightness)
 
 exportIntelBacklight
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)

From adfbb92136a73d50cc47efd710679e7857b93c76 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 19:28:41 -0500
Subject: [PATCH 100/118] ENH generalize all desktop commands

---
 bin/xmonad.hs                          | 52 +++++++++---------
 lib/XMonad/Internal/Command/Desktop.hs | 75 ++++++++++++++++----------
 2 files changed, 75 insertions(+), 52 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 488d2a0..710312d 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -806,40 +806,40 @@ externalBindings runIO cleanup db =
       , KeyBinding "M-b" "launch bitwarden selector" $ Left $ runBwMenu ses
       , KeyBinding "M-v" "launch ExpressVPN selector" $ Left runVPNMenu
       , KeyBinding "M-e" "launch bluetooth selector" $ Left runBTMenu
-      , KeyBinding "M-C-e" "launch editor" $ Left runEditor
-      , KeyBinding "M-C-w" "launch browser" $ Left runBrowser
-      , KeyBinding "M-C-t" "launch terminal with tmux" $ Left runTMux
-      , KeyBinding "M-C-S-t" "launch terminal" $ Left runTerm
-      , KeyBinding "M-C-q" "launch calc" $ Left runCalc
-      , KeyBinding "M-C-f" "launch file manager" $ Left runFileManager
+      , KeyBinding "M-C-e" "launch editor" $ Left $ toX runEditor
+      , KeyBinding "M-C-w" "launch browser" $ Left $ toX runBrowser
+      , KeyBinding "M-C-t" "launch terminal with tmux" $ Left $ toX runTMux
+      , KeyBinding "M-C-S-t" "launch terminal" $ Left $ toX runTerm
+      , KeyBinding "M-C-q" "launch calc" $ Left $ toX runCalc
+      , KeyBinding "M-C-f" "launch file manager" $ Left $ toX runFileManager
       ]
   , KeyGroup
       "Actions"
       [ KeyBinding "M-q" "close window" $ ftrAlways "kill window function" kill1
       , KeyBinding "M-r" "run program" $ Left runCmdMenu
       , KeyBinding "M-<Space>" "warp pointer" $ ftrAlways "warp function" $ warpToWindow 0.5 0.5
-      , KeyBinding "M-C-s" "capture area" $ Left $ runAreaCapture ses
-      , KeyBinding "M-C-S-s" "capture screen" $ Left $ runScreenCapture ses
-      , KeyBinding "M-C-d" "capture desktop" $ Left $ runDesktopCapture ses
-      , KeyBinding "M-C-b" "browse captures" $ Left runCaptureBrowser
+      , KeyBinding "M-C-s" "capture area" $ Left $ toX $ runAreaCapture ses
+      , KeyBinding "M-C-S-s" "capture screen" $ Left $ toX $ runScreenCapture ses
+      , KeyBinding "M-C-d" "capture desktop" $ Left $ toX $ runDesktopCapture ses
+      , KeyBinding "M-C-b" "browse captures" $ Left $ toX runCaptureBrowser
       -- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
       ]
   , KeyGroup
       "Multimedia"
-      [ KeyBinding "<XF86AudioPlay>" "toggle play/pause" $ Left runTogglePlay
-      , KeyBinding "<XF86AudioPrev>" "previous track" $ Left runPrevTrack
-      , KeyBinding "<XF86AudioNext>" "next track" $ Left runNextTrack
-      , KeyBinding "<XF86AudioStop>" "stop" $ Left runStopPlay
-      , KeyBinding "<XF86AudioLowerVolume>" "volume down" $ Left runVolumeDown
-      , KeyBinding "<XF86AudioRaiseVolume>" "volume up" $ Left runVolumeUp
-      , KeyBinding "<XF86AudioMute>" "volume mute" $ Left runVolumeMute
+      [ KeyBinding "<XF86AudioPlay>" "toggle play/pause" $ Left $ toX runTogglePlay
+      , KeyBinding "<XF86AudioPrev>" "previous track" $ Left $ toX runPrevTrack
+      , KeyBinding "<XF86AudioNext>" "next track" $ Left $ toX runNextTrack
+      , KeyBinding "<XF86AudioStop>" "stop" $ Left $ toX runStopPlay
+      , KeyBinding "<XF86AudioLowerVolume>" "volume down" $ Left $ toX runVolumeDown
+      , KeyBinding "<XF86AudioRaiseVolume>" "volume up" $ Left $ toX runVolumeUp
+      , KeyBinding "<XF86AudioMute>" "volume mute" $ Left $ toX runVolumeMute
       ]
   , KeyGroup
       "Dunst"
-      [ KeyBinding "M-`" "dunst history" $ Left $ runNotificationHistory ses
-      , KeyBinding "M-S-`" "dunst close" $ Left $ runNotificationClose ses
-      , KeyBinding "M-M1-`" "dunst context menu" $ Left $ runNotificationContext ses
-      , KeyBinding "M-C-`" "dunst close all" $ Left $ runNotificationCloseAll ses
+      [ KeyBinding "M-`" "dunst history" $ Left $ toX $ runNotificationHistory ses
+      , KeyBinding "M-S-`" "dunst close" $ Left $ toX $ runNotificationClose ses
+      , KeyBinding "M-M1-`" "dunst context menu" $ Left $ toX $ runNotificationContext ses
+      , KeyBinding "M-C-`" "dunst close all" $ Left $ toX $ runNotificationCloseAll ses
       ]
   , KeyGroup
       "System"
@@ -858,21 +858,23 @@ externalBindings runIO cleanup db =
         KeyBinding "M-<F2>" "restart xmonad" restartf
       , KeyBinding "M-<F3>" "recompile xmonad" recompilef
       , KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
-      , KeyBinding "M-<F9>" "toggle ethernet" $ Left runToggleEthernet
-      , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ runToggleBluetooth sys
-      , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ liftIO . runIO <$> callToggle ses
+      , KeyBinding "M-<F9>" "toggle ethernet" $ Left $ toX runToggleEthernet
+      , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ toX $ runToggleBluetooth sys
+      , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ toX $ callToggle ses
       , KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt
       ]
   ]
   where
     ses = dbSesClient db
     sys = dbSysClient db
-    brightessControls ctl getter = (fmap (liftIO . runIO) . getter . ctl) ses
+    brightessControls ctl getter = (toX . getter . ctl) ses
     ib = Left . brightessControls intelBacklightControls
     ck = Left . brightessControls clevoKeyboardControls
     ftrAlways n = Right . Always n . Always_ . FallbackAlone
     restartf = ftrAlways "restart function" (cleanup >> runRestart)
     recompilef = ftrAlways "recompile function" runRecompile
+    toX_ = liftIO . runIO
+    toX = fmap toX_
 
 type MaybeX = Maybe (X ())
 
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 0ed6eae..af27524 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -119,10 +119,10 @@ volumeChangeSound = "smb_fireball.wav"
 --------------------------------------------------------------------------------
 -- Some nice apps
 
-runTerm :: SometimesX
+runTerm :: MonadUnliftIO m => Sometimes (m ())
 runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm
 
-runTMux :: SometimesX
+runTMux :: MonadUnliftIO m => Sometimes (m ())
 runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
   where
     deps =
@@ -140,13 +140,13 @@ runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
       t <- getTemporaryDirectory
       return $ t </> "tmux-" ++ show u </> "default"
 
-runCalc :: SometimesX
+runCalc :: MonadUnliftIO m => Sometimes (m ())
 runCalc = sometimesIO_ "calculator" "bc" deps act
   where
     deps = toAnd_ (sysExe myTermPkgs myTerm) (sysExe [Package Official "bc"] myCalc)
     act = spawnCmd myTerm ["-e", T.pack myCalc, "-l"]
 
-runBrowser :: SometimesX
+runBrowser :: MonadUnliftIO m => Sometimes (m ())
 runBrowser =
   sometimesExe
     "web browser"
@@ -155,7 +155,7 @@ runBrowser =
     False
     myBrowser
 
-runEditor :: SometimesX
+runEditor :: MonadUnliftIO m => Sometimes (m ())
 runEditor = sometimesIO_ "text editor" "emacs" tree cmd
   where
     cmd =
@@ -166,7 +166,7 @@ runEditor = sometimesIO_ "text editor" "emacs" tree cmd
     -- before xmonad starts, so just check to see if the process has started
     tree = toAnd_ (sysExe myEditorPkgs myEditor) $ process [] $ T.pack myEditorServer
 
-runFileManager :: SometimesX
+runFileManager :: MonadUnliftIO m => Sometimes (m ())
 runFileManager =
   sometimesExe
     "file browser"
@@ -178,7 +178,11 @@ runFileManager =
 --------------------------------------------------------------------------------
 -- Multimedia Commands
 
-runMultimediaIfInstalled :: T.Text -> T.Text -> SometimesX
+runMultimediaIfInstalled
+  :: MonadUnliftIO m
+  => T.Text
+  -> T.Text
+  -> Sometimes (m ())
 runMultimediaIfInstalled n cmd =
   sometimesExeArgs
     (T.append n " multimedia control")
@@ -188,16 +192,16 @@ runMultimediaIfInstalled n cmd =
     myMultimediaCtl
     [cmd]
 
-runTogglePlay :: SometimesX
+runTogglePlay :: MonadUnliftIO m => Sometimes (m ())
 runTogglePlay = runMultimediaIfInstalled "play/pause" "play-pause"
 
-runPrevTrack :: SometimesX
+runPrevTrack :: MonadUnliftIO m => Sometimes (m ())
 runPrevTrack = runMultimediaIfInstalled "previous track" "previous"
 
-runNextTrack :: SometimesX
+runNextTrack :: MonadUnliftIO m => Sometimes (m ())
 runNextTrack = runMultimediaIfInstalled "next track" "next"
 
-runStopPlay :: SometimesX
+runStopPlay :: MonadUnliftIO m => Sometimes (m ())
 runStopPlay = runMultimediaIfInstalled "stop playback" "stop"
 
 --------------------------------------------------------------------------------
@@ -213,7 +217,13 @@ playSound file = do
   -- paplay seems to have less latency than aplay
   spawnCmd "paplay" [T.pack p]
 
-featureSound :: T.Text -> FilePath -> X () -> X () -> SometimesX
+featureSound
+  :: MonadUnliftIO m
+  => T.Text
+  -> FilePath
+  -> m ()
+  -> m ()
+  -> Sometimes (m ())
 featureSound n file pre post =
   sometimesIO_ (T.unwords ["volume", n, " control"]) "paplay" tree $
     pre >> playSound file >> post
@@ -222,19 +232,24 @@ featureSound n file pre post =
     -- to play sound (duh) but libpulse is the package with the paplay binary
     tree = Only_ $ sysExe [Package Official "pulseaudio"] "paplay"
 
-runVolumeDown :: SometimesX
+runVolumeDown :: MonadUnliftIO m => Sometimes (m ())
 runVolumeDown = featureSound "up" volumeChangeSound (return ()) $ void (lowerVolume 2)
 
-runVolumeUp :: SometimesX
+runVolumeUp :: MonadUnliftIO m => Sometimes (m ())
 runVolumeUp = featureSound "down" volumeChangeSound (return ()) $ void (raiseVolume 2)
 
-runVolumeMute :: SometimesX
+runVolumeMute :: MonadUnliftIO m => Sometimes (m ())
 runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return ()
 
 --------------------------------------------------------------------------------
 -- Notification control
 
-runNotificationCmd :: T.Text -> T.Text -> Maybe SesClient -> SometimesX
+runNotificationCmd
+  :: MonadUnliftIO m
+  => T.Text
+  -> T.Text
+  -> Maybe SesClient
+  -> Sometimes (m ())
 runNotificationCmd n arg cl =
   sometimesDBus cl (T.unwords [n, "control"]) "dunstctl" tree cmd
   where
@@ -245,18 +260,18 @@ runNotificationCmd n arg cl =
           Method_ $
             memberName_ "NotificationAction"
 
-runNotificationClose :: Maybe SesClient -> SometimesX
+runNotificationClose :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationClose = runNotificationCmd "close notification" "close"
 
-runNotificationCloseAll :: Maybe SesClient -> SometimesX
+runNotificationCloseAll :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationCloseAll =
   runNotificationCmd "close all notifications" "close-all"
 
-runNotificationHistory :: Maybe SesClient -> SometimesX
+runNotificationHistory :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationHistory =
   runNotificationCmd "see notification history" "history-pop"
 
-runNotificationContext :: Maybe SesClient -> SometimesX
+runNotificationContext :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationContext =
   runNotificationCmd "open notification context" "context"
 
@@ -275,7 +290,7 @@ runNetAppDaemon cl =
     app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
     cmd _ = P.proc "nm-applet" [] (P.startProcess . P.setCreateGroup True)
 
-runToggleBluetooth :: Maybe SysClient -> SometimesX
+runToggleBluetooth :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
 runToggleBluetooth cl =
   Sometimes
     "bluetooth toggle"
@@ -292,7 +307,7 @@ runToggleBluetooth cl =
           #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
           #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "bluetooth powered $a"}
 
-runToggleEthernet :: SometimesX
+runToggleEthernet :: MonadUnliftIO m => Sometimes (m ())
 runToggleEthernet =
   Sometimes
     "ethernet toggle"
@@ -320,6 +335,7 @@ runToggleEthernet =
 runRestart :: X ()
 runRestart = restart "xmonad" True
 
+-- TODO use rio in here so I don't have to fill my xinit log with stack poop
 -- TODO only recompile the VM binary if we have virtualbox enabled
 runRecompile :: X ()
 runRecompile = do
@@ -348,7 +364,12 @@ getCaptureDir = do
   where
     fallback = (</> ".local/share") <$> getHomeDirectory
 
-runFlameshot :: T.Text -> T.Text -> Maybe SesClient -> SometimesX
+runFlameshot
+  :: MonadUnliftIO m
+  => T.Text
+  -> T.Text
+  -> Maybe SesClient
+  -> Sometimes (m ())
 runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd
   where
     cmd _ = spawnCmd myCapture [mode]
@@ -359,18 +380,18 @@ runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd
 
 -- TODO this will steal focus from the current window (and puts it
 -- in the root window?) ...need to fix
-runAreaCapture :: Maybe SesClient -> SometimesX
+runAreaCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runAreaCapture = runFlameshot "screen area capture" "gui"
 
 -- myWindowCap = "screencap -w" --external script
 
-runDesktopCapture :: Maybe SesClient -> SometimesX
+runDesktopCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runDesktopCapture = runFlameshot "fullscreen capture" "full"
 
-runScreenCapture :: Maybe SesClient -> SometimesX
+runScreenCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runScreenCapture = runFlameshot "screen capture" "screen"
 
-runCaptureBrowser :: SometimesX
+runCaptureBrowser :: MonadUnliftIO m => Sometimes (m ())
 runCaptureBrowser = sometimesIO_
   "screen capture browser"
   "feh"

From 394eca3ad2071b963a5df37e60920b879777532c Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 19:32:12 -0500
Subject: [PATCH 101/118] ENH generalize (most) dmenu commands

---
 bin/xmonad.hs                        | 20 ++++++++++----------
 lib/XMonad/Internal/Command/DMenu.hs | 23 ++++++++++++-----------
 2 files changed, 22 insertions(+), 21 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 710312d..fc19049 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -798,14 +798,14 @@ externalBindings :: (XIO () -> IO ()) -> X () -> DBusState -> [KeyGroup FeatureX
 externalBindings runIO cleanup db =
   [ KeyGroup
       "Launchers"
-      [ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu
-      , KeyBinding "M-g" "launch clipboard manager" $ Left runClipMenu
-      , KeyBinding "M-a" "launch network selector" $ Left $ runNetMenu sys
-      , KeyBinding "M-w" "launch window selector" $ Left runWinMenu
-      , KeyBinding "M-u" "launch device selector" $ Left runDevMenu
-      , KeyBinding "M-b" "launch bitwarden selector" $ Left $ runBwMenu ses
-      , KeyBinding "M-v" "launch ExpressVPN selector" $ Left runVPNMenu
-      , KeyBinding "M-e" "launch bluetooth selector" $ Left runBTMenu
+      [ KeyBinding "<XF86Search>" "select/launch app" $ Left $ toX runAppMenu
+      , KeyBinding "M-g" "launch clipboard manager" $ Left $ toX runClipMenu
+      , KeyBinding "M-a" "launch network selector" $ Left $ toX $ runNetMenu sys
+      , KeyBinding "M-w" "launch window selector" $ Left $ toX runWinMenu
+      , KeyBinding "M-u" "launch device selector" $ Left $ toX runDevMenu
+      , KeyBinding "M-b" "launch bitwarden selector" $ Left $ toX $ runBwMenu ses
+      , KeyBinding "M-v" "launch ExpressVPN selector" $ Left $ toX runVPNMenu
+      , KeyBinding "M-e" "launch bluetooth selector" $ Left $ toX runBTMenu
       , KeyBinding "M-C-e" "launch editor" $ Left $ toX runEditor
       , KeyBinding "M-C-w" "launch browser" $ Left $ toX runBrowser
       , KeyBinding "M-C-t" "launch terminal with tmux" $ Left $ toX runTMux
@@ -816,7 +816,7 @@ externalBindings runIO cleanup db =
   , KeyGroup
       "Actions"
       [ KeyBinding "M-q" "close window" $ ftrAlways "kill window function" kill1
-      , KeyBinding "M-r" "run program" $ Left runCmdMenu
+      , KeyBinding "M-r" "run program" $ Left $ toX runCmdMenu
       , KeyBinding "M-<Space>" "warp pointer" $ ftrAlways "warp function" $ warpToWindow 0.5 0.5
       , KeyBinding "M-C-s" "capture area" $ Left $ toX $ runAreaCapture ses
       , KeyBinding "M-C-S-s" "capture screen" $ Left $ toX $ runScreenCapture ses
@@ -857,7 +857,7 @@ externalBindings runIO cleanup db =
       , -- M-<F1> reserved for showing the keymap
         KeyBinding "M-<F2>" "restart xmonad" restartf
       , KeyBinding "M-<F3>" "recompile xmonad" recompilef
-      , KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
+      , KeyBinding "M-<F8>" "select autorandr profile" $ Left $ toX runAutorandrMenu
       , KeyBinding "M-<F9>" "toggle ethernet" $ Left $ toX runToggleEthernet
       , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ toX $ runToggleBluetooth sys
       , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ toX $ callToggle ses
diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index 2614feb..7a6c605 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -22,6 +22,7 @@ import DBus
 import Data.Internal.DBus
 import Data.Internal.XIO
 import Graphics.X11.Types
+import RIO hiding (hClose)
 import RIO.Directory
   ( XdgDirectory (..)
   , getXdgDirectory
@@ -74,7 +75,7 @@ clipboardPkgs = [Package AUR "rofi-greenclip"]
 --------------------------------------------------------------------------------
 -- Other internal functions
 
-spawnDmenuCmd :: T.Text -> [T.Text] -> SometimesX
+spawnDmenuCmd :: MonadUnliftIO m => T.Text -> [T.Text] -> Sometimes (m ())
 spawnDmenuCmd n =
   sometimesExeArgs n "rofi preset" dmenuPkgs True myDmenuCmd
 
@@ -97,7 +98,7 @@ dmenuDep = sysExe dmenuPkgs myDmenuCmd
 -- Exported Commands
 
 -- TODO test that veracrypt and friends are installed
-runDevMenu :: SometimesX
+runDevMenu :: MonadUnliftIO m => Sometimes (m ())
 runDevMenu = sometimesIO_ "device manager" "rofi devices" t x
   where
     t = dmenuTree $ Only_ (localExe [] myDmenuDevices)
@@ -110,7 +111,7 @@ runDevMenu = sometimesIO_ "device manager" "rofi devices" t x
           ++ myDmenuMatchingArgs
 
 -- TODO test that bluetooth interface exists
-runBTMenu :: SometimesX
+runBTMenu :: MonadUnliftIO m => Sometimes (m ())
 runBTMenu =
   Sometimes
     "bluetooth selector"
@@ -120,7 +121,7 @@ runBTMenu =
     cmd = spawnCmd myDmenuBluetooth $ "-c" : themeArgs "#0044bb"
     tree = dmenuTree $ Only_ $ sysExe [] myDmenuBluetooth
 
-runVPNMenu :: SometimesX
+runVPNMenu :: MonadUnliftIO m => Sometimes (m ())
 runVPNMenu =
   Sometimes
     "VPN selector"
@@ -136,16 +137,16 @@ runVPNMenu =
           socketExists "expressVPN" [] $
             return "/var/lib/expressvpn/expressvpnd.socket"
 
-runCmdMenu :: SometimesX
+runCmdMenu :: MonadUnliftIO m => Sometimes (m ())
 runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
 
-runAppMenu :: SometimesX
+runAppMenu :: MonadUnliftIO m => Sometimes (m ())
 runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"]
 
-runWinMenu :: SometimesX
+runWinMenu :: MonadUnliftIO m => Sometimes (m ())
 runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]
 
-runNetMenu :: Maybe SysClient -> SometimesX
+runNetMenu :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
 runNetMenu cl =
   Sometimes
     "network control menu"
@@ -161,7 +162,7 @@ runNetMenu cl =
           DBusIO $
             sysExe [Package AUR "networkmanager-dmenu-git"] myDmenuNetworks
 
-runAutorandrMenu :: SometimesX
+runAutorandrMenu :: MonadUnliftIO m => Sometimes (m ())
 runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
   where
     cmd = spawnCmd myDmenuMonitors $ themeArgs "#ff0066"
@@ -170,7 +171,7 @@ runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
 --------------------------------------------------------------------------------
 -- Password manager
 
-runBwMenu :: Maybe SesClient -> SometimesX
+runBwMenu :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd
   where
     cmd _ =
@@ -183,7 +184,7 @@ runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd
 --------------------------------------------------------------------------------
 -- Clipboard
 
-runClipMenu :: SometimesX
+runClipMenu :: MonadUnliftIO m => Sometimes (m ())
 runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
   where
     act = spawnCmd myDmenuCmd args

From 1cf9e3e8bd9ea02e0a5b06b7a0461f1276fc7273 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 19:44:17 -0500
Subject: [PATCH 102/118] ENH generalize showkyes

---
 bin/xmonad.hs                        |  4 ++--
 lib/XMonad/Internal/Command/DMenu.hs | 20 +++++++++++++-------
 2 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index fc19049..73193ef 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -129,7 +129,7 @@ run = do
           tt <- evalAlways $ fsTabbedTheme fs
           let conf =
                 ewmh $
-                  addKeymap dws sk kbs $
+                  addKeymap dws (liftIO . runIO . sk) kbs $
                     docks $
                       def
                         { terminal = myTerm
@@ -179,7 +179,7 @@ data FeatureSet = FeatureSet
   , fsACPIHandler :: Always (String -> X ())
   , fsTabbedTheme :: Always Theme
   , fsDynWorkspaces :: [Sometimes DynWorkspace]
-  , fsShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
+  , fsShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> XIO ())
   }
 
 tabbedFeature :: Always Theme
diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index 7a6c605..0956ee5 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -19,16 +19,18 @@ module XMonad.Internal.Command.DMenu
 where
 
 import DBus
+import qualified Data.ByteString.Char8 as BC
 import Data.Internal.DBus
 import Data.Internal.XIO
 import Graphics.X11.Types
-import RIO hiding (hClose)
+import RIO
+import qualified RIO.ByteString as B
 import RIO.Directory
   ( XdgDirectory (..)
   , getXdgDirectory
   )
 import qualified RIO.Text as T
-import System.IO
+-- import System.IO
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
@@ -207,7 +209,9 @@ runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
 --------------------------------------------------------------------------------
 -- Shortcut menu
 
-runShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
+runShowKeys
+  :: MonadUnliftIO m
+  => Always ([((KeyMask, KeySym), NamedAction)] -> m ())
 runShowKeys =
   Always "keyboard menu" $
     Option showKeysDMenu $
@@ -220,18 +224,20 @@ runShowKeys =
         spawnNotify $
           defNoteError {body = Just $ Text "could not display keymap"}
 
-showKeysDMenu :: SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> X ())
+showKeysDMenu
+  :: MonadUnliftIO m
+  => SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> m ())
 showKeysDMenu =
   Subfeature
     { sfName = "keyboard shortcut menu"
     , sfData = IORoot_ showKeys $ Only_ dmenuDep
     }
 
-showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
+showKeys :: MonadUnliftIO m => [((KeyMask, KeySym), NamedAction)] -> m ()
 showKeys kbs = do
   h <- spawnPipe cmd
-  io $ hPutStr h $ unlines $ showKm kbs
-  io $ hClose h
+  B.hPut h $ BC.unlines $ BC.pack <$> showKm kbs
+  hClose h
   where
     cmd =
       fmtCmd myDmenuCmd $

From 12b68f7377444a0a8e56a8406a8c9ed2b92dae07 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 19:48:48 -0500
Subject: [PATCH 103/118] ENH kinda generalize power prompts

---
 lib/XMonad/Internal/Command/Power.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs
index 125030c..b324339 100644
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@@ -69,16 +69,16 @@ runScreenLock =
     False
     myScreenlock
 
-runPowerOff :: X ()
+runPowerOff :: MonadUnliftIO m => m ()
 runPowerOff = spawn "systemctl poweroff"
 
-runSuspend :: X ()
+runSuspend :: MonadUnliftIO m => m ()
 runSuspend = spawn "systemctl suspend"
 
-runHibernate :: X ()
+runHibernate :: MonadUnliftIO m => m ()
 runHibernate = spawn "systemctl hibernate"
 
-runReboot :: X ()
+runReboot :: MonadUnliftIO m => m ()
 runReboot = spawn "systemctl reboot"
 
 --------------------------------------------------------------------------------
@@ -106,7 +106,7 @@ confirmPrompt' :: T.Text -> X () -> XT.FontBuilder -> X ()
 confirmPrompt' s x fb = confirmPrompt (XT.promptTheme fb) (T.unpack s) x
 
 suspendPrompt :: XT.FontBuilder -> X ()
-suspendPrompt = confirmPrompt' "suspend?" runSuspend
+suspendPrompt = confirmPrompt' "suspend?" $ liftIO runSuspend
 
 quitPrompt :: XT.FontBuilder -> X ()
 quitPrompt = confirmPrompt' "quit?" $ io exitSuccess
@@ -224,7 +224,7 @@ powerPrompt lock fb = mkXPrompt PowerPrompt theme comp executeMaybeAction
             ]
     sendMaybeAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
     executeMaybeAction a = case toEnum $ read a of
-      Poweroff -> runPowerOff
-      Shutdown -> lock >> runSuspend
-      Hibernate -> lock >> runHibernate
-      Reboot -> runReboot
+      Poweroff -> liftIO runPowerOff
+      Shutdown -> lock >> liftIO runSuspend
+      Hibernate -> lock >> liftIO runHibernate
+      Reboot -> liftIO runReboot

From 0895586cf7393d43419df83f13938aadab762164 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 19:50:44 -0500
Subject: [PATCH 104/118] FIX missed a spot

---
 lib/XMonad/Internal/Concurrent/ACPIEvent.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
index 756dd33..a543ade 100644
--- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
+++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
@@ -98,7 +98,7 @@ handleACPI fb lock tag = do
     LidClose -> do
       status <- io isDischarging
       -- only run suspend if battery exists and is discharging
-      forM_ status $ flip when runSuspend
+      forM_ status $ flip when $ liftIO runSuspend
       lock
 
 --------------------------------------------------------------------------------

From 6891238793d882f39f3c939137fbe54459bc83f2 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 19:55:44 -0500
Subject: [PATCH 105/118] ENH add log contraints to spawnpipe

---
 lib/XMonad/Internal/Command/DMenu.hs | 9 ++++++---
 lib/XMonad/Internal/Shell.hs         | 5 ++++-
 2 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index 0956ee5..946bbd7 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@@ -210,7 +210,7 @@ runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
 -- Shortcut menu
 
 runShowKeys
-  :: MonadUnliftIO m
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => Always ([((KeyMask, KeySym), NamedAction)] -> m ())
 runShowKeys =
   Always "keyboard menu" $
@@ -225,7 +225,7 @@ runShowKeys =
           defNoteError {body = Just $ Text "could not display keymap"}
 
 showKeysDMenu
-  :: MonadUnliftIO m
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> m ())
 showKeysDMenu =
   Subfeature
@@ -233,7 +233,10 @@ showKeysDMenu =
     , sfData = IORoot_ showKeys $ Only_ dmenuDep
     }
 
-showKeys :: MonadUnliftIO m => [((KeyMask, KeySym), NamedAction)] -> m ()
+showKeys
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => [((KeyMask, KeySym), NamedAction)]
+  -> m ()
 showKeys kbs = do
   h <- spawnPipe cmd
   B.hPut h $ BC.unlines $ BC.pack <$> showKm kbs
diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index 70a3e6c..ee2aad9 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -85,7 +85,10 @@ spawn :: MonadIO m => T.Text -> m ()
 spawn = X.spawn . T.unpack
 
 -- | Run 'XMonad.Run.Utils.spawnPipe' with 'Text' input.
-spawnPipe :: MonadIO m => T.Text -> m Handle
+spawnPipe
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => T.Text
+  -> m Handle
 spawnPipe = XR.spawnPipe . T.unpack
 
 -- | Run 'XMonad.Core.spawn' with a command and arguments

From 774fba0c7118c58a2461ad8cba671036d6f7c478 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 20:36:38 -0500
Subject: [PATCH 106/118] WIP log output from child processes

---
 lib/XMonad/Internal/Shell.hs | 34 ++++++++++++++++++++++++++++++++--
 1 file changed, 32 insertions(+), 2 deletions(-)

diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index ee2aad9..9dd671c 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -22,9 +22,13 @@ where
 
 import RIO
 import qualified RIO.Text as T
+import System.IO hiding (hSetBuffering)
+import System.Posix.IO
+import System.Posix.Process
 import qualified System.Process.Typed as P
 import qualified XMonad.Core as X
-import qualified XMonad.Util.Run as XR
+
+-- import qualified XMonad.Util.Run as XR
 
 -- | Fork a new process and wait for its exit code.
 --
@@ -89,7 +93,33 @@ spawnPipe
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => T.Text
   -> m Handle
-spawnPipe = XR.spawnPipe . T.unpack
+spawnPipe = fmap fst . spawnPipeRW
+
+spawnPipeRW :: MonadIO m => T.Text -> m (Handle, Handle)
+spawnPipeRW x = liftIO $ do
+  (rI, wI) <- createPipe
+  (rO, wO) <- createPipe
+  -- I'm assuming the only place this matters is when xmonad is restarted (which
+  -- calls exec); since these are the ends of the pipe that xmonad will be
+  -- using, this ensures they will be closed when restarting
+  forM_ [wI, rO] $ \fd -> setFdOption fd CloseOnExec True
+  hI <- mkHandle wI
+  hO <- mkHandle rO
+  void $ X.xfork $ do
+    void $ dupTo rI stdInput
+    void $ dupTo wO stdOutput
+    void $ dupTo wO stdError
+    executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
+  closeFd rI
+  closeFd wO
+  return (hI, hO)
+  where
+    mkHandle fd = do
+      h <- fdToHandle fd
+      -- ASSUME we are using utf8 everywhere
+      hSetEncoding h utf8
+      hSetBuffering h LineBuffering
+      return h
 
 -- | Run 'XMonad.Core.spawn' with a command and arguments
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()

From bfa7f4081828036364ad65c81379dfde8d77d15b Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 20:57:07 -0500
Subject: [PATCH 107/118] WIP try dup-ing the read pipe to stderr

---
 lib/XMonad/Internal/Shell.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index 9dd671c..88566e7 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -93,26 +93,26 @@ spawnPipe
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => T.Text
   -> m Handle
-spawnPipe = fmap fst . spawnPipeRW
+spawnPipe = liftIO . spawnPipeRW
 
-spawnPipeRW :: MonadIO m => T.Text -> m (Handle, Handle)
-spawnPipeRW x = liftIO $ do
+spawnPipeRW :: T.Text -> IO Handle
+spawnPipeRW x = do
   (rI, wI) <- createPipe
   (rO, wO) <- createPipe
   -- I'm assuming the only place this matters is when xmonad is restarted (which
   -- calls exec); since these are the ends of the pipe that xmonad will be
   -- using, this ensures they will be closed when restarting
   forM_ [wI, rO] $ \fd -> setFdOption fd CloseOnExec True
-  hI <- mkHandle wI
-  hO <- mkHandle rO
+  h <- mkHandle wI
   void $ X.xfork $ do
     void $ dupTo rI stdInput
     void $ dupTo wO stdOutput
     void $ dupTo wO stdError
     executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
+  void $ dupTo stdError rO
   closeFd rI
   closeFd wO
-  return (hI, hO)
+  return h
   where
     mkHandle fd = do
       h <- fdToHandle fd

From 66550a08a6a2a32b41f6d6c27482a6e61f5ddb97 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 21:01:12 -0500
Subject: [PATCH 108/118] WIP try dup-ing stderr from parent process

---
 lib/XMonad/Internal/Shell.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index 88566e7..d59adc9 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -98,20 +98,19 @@ spawnPipe = liftIO . spawnPipeRW
 spawnPipeRW :: T.Text -> IO Handle
 spawnPipeRW x = do
   (rI, wI) <- createPipe
-  (rO, wO) <- createPipe
+  -- (rO, wO) <- createPipe
   -- I'm assuming the only place this matters is when xmonad is restarted (which
   -- calls exec); since these are the ends of the pipe that xmonad will be
   -- using, this ensures they will be closed when restarting
-  forM_ [wI, rO] $ \fd -> setFdOption fd CloseOnExec True
+  err <- dup stdError
+  forM_ [wI, err] $ \fd -> setFdOption fd CloseOnExec True
   h <- mkHandle wI
   void $ X.xfork $ do
     void $ dupTo rI stdInput
-    void $ dupTo wO stdOutput
-    void $ dupTo wO stdError
+    void $ dupTo err stdOutput
+    void $ dupTo err stdError
     executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
-  void $ dupTo stdError rO
   closeFd rI
-  closeFd wO
   return h
   where
     mkHandle fd = do

From 5b2c66033a4d2d3b89683e8b2c1b4ae02d01363e Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 21:39:49 -0500
Subject: [PATCH 109/118] ENH fork env in child process (duh)

---
 lib/XMonad/Internal/Shell.hs | 35 ++++++++++++++++-------------------
 1 file changed, 16 insertions(+), 19 deletions(-)

diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index d59adc9..b8fa339 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -93,32 +93,29 @@ spawnPipe
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => T.Text
   -> m Handle
-spawnPipe = liftIO . spawnPipeRW
+spawnPipe = spawnPipeRW
 
-spawnPipeRW :: T.Text -> IO Handle
+spawnPipeRW
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => T.Text
+  -> m Handle
 spawnPipeRW x = do
-  (rI, wI) <- createPipe
-  -- (rO, wO) <- createPipe
-  -- I'm assuming the only place this matters is when xmonad is restarted (which
-  -- calls exec); since these are the ends of the pipe that xmonad will be
-  -- using, this ensures they will be closed when restarting
-  err <- dup stdError
-  forM_ [wI, err] $ \fd -> setFdOption fd CloseOnExec True
-  h <- mkHandle wI
-  void $ X.xfork $ do
-    void $ dupTo rI stdInput
-    void $ dupTo err stdOutput
-    void $ dupTo err stdError
-    executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
-  closeFd rI
+  (r, h) <- liftIO mkPipe
+  void $ withRunInIO $ \runIO -> do
+    X.xfork $ runIO $ do
+      void $ liftIO $ dupTo r stdInput
+      liftIO $ executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
+  liftIO $ closeFd r
   return h
   where
-    mkHandle fd = do
-      h <- fdToHandle fd
+    mkPipe = do
+      (r, w) <- createPipe
+      setFdOption w CloseOnExec True
+      h <- fdToHandle w
       -- ASSUME we are using utf8 everywhere
       hSetEncoding h utf8
       hSetBuffering h LineBuffering
-      return h
+      return (r, h)
 
 -- | Run 'XMonad.Core.spawn' with a command and arguments
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()

From f0451891b842c69d12ae06824e82e080bcba9ca8 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 22:12:47 -0500
Subject: [PATCH 110/118] REF make spawnPipe clearer

---
 lib/XMonad/Internal/Shell.hs | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index b8fa339..390d553 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -101,10 +101,7 @@ spawnPipeRW
   -> m Handle
 spawnPipeRW x = do
   (r, h) <- liftIO mkPipe
-  void $ withRunInIO $ \runIO -> do
-    X.xfork $ runIO $ do
-      void $ liftIO $ dupTo r stdInput
-      liftIO $ executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
+  child r
   liftIO $ closeFd r
   return h
   where
@@ -116,6 +113,10 @@ spawnPipeRW x = do
       hSetEncoding h utf8
       hSetBuffering h LineBuffering
       return (r, h)
+    child r = void $ withRunInIO $ \runIO -> do
+      X.xfork $ runIO $ do
+        void $ liftIO $ dupTo r stdInput
+        liftIO $ executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
 
 -- | Run 'XMonad.Core.spawn' with a command and arguments
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()

From f95079ba5ea5714e224fd38bd74276c949bf7a7c Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Mon, 2 Jan 2023 22:20:43 -0500
Subject: [PATCH 111/118] REF undo homegrown pipe command

---
 lib/XMonad/Internal/Shell.hs | 52 +++++++++++++++++-------------------
 1 file changed, 24 insertions(+), 28 deletions(-)

diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index 390d553..e91a0ed 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@@ -22,13 +22,9 @@ where
 
 import RIO
 import qualified RIO.Text as T
-import System.IO hiding (hSetBuffering)
-import System.Posix.IO
-import System.Posix.Process
 import qualified System.Process.Typed as P
 import qualified XMonad.Core as X
-
--- import qualified XMonad.Util.Run as XR
+import qualified XMonad.Util.Run as XR
 
 -- | Fork a new process and wait for its exit code.
 --
@@ -93,30 +89,30 @@ spawnPipe
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => T.Text
   -> m Handle
-spawnPipe = spawnPipeRW
+spawnPipe = liftIO . XR.spawnPipe . T.unpack
 
-spawnPipeRW
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => T.Text
-  -> m Handle
-spawnPipeRW x = do
-  (r, h) <- liftIO mkPipe
-  child r
-  liftIO $ closeFd r
-  return h
-  where
-    mkPipe = do
-      (r, w) <- createPipe
-      setFdOption w CloseOnExec True
-      h <- fdToHandle w
-      -- ASSUME we are using utf8 everywhere
-      hSetEncoding h utf8
-      hSetBuffering h LineBuffering
-      return (r, h)
-    child r = void $ withRunInIO $ \runIO -> do
-      X.xfork $ runIO $ do
-        void $ liftIO $ dupTo r stdInput
-        liftIO $ executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
+-- spawnPipeRW
+--   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+--   => T.Text
+--   -> m Handle
+-- spawnPipeRW x = do
+--   (r, h) <- liftIO mkPipe
+--   child r
+--   liftIO $ closeFd r
+--   return h
+--   where
+--     mkPipe = do
+--       (r, w) <- createPipe
+--       setFdOption w CloseOnExec True
+--       h <- fdToHandle w
+--       -- ASSUME we are using utf8 everywhere
+--       hSetEncoding h utf8
+--       hSetBuffering h LineBuffering
+--       return (r, h)
+--     child r = void $ withRunInIO $ \runIO -> do
+--       X.xfork $ runIO $ do
+--         void $ liftIO $ dupTo r stdInput
+--         liftIO $ executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
 
 -- | Run 'XMonad.Core.spawn' with a command and arguments
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()

From a0cdcce146abcbfcff3203c01d9e4b884c1916e0 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 3 Jan 2023 22:18:55 -0500
Subject: [PATCH 112/118] ENH hold client in monad

---
 lib/Data/Internal/DBus.hs                     | 160 +++++++++++++-----
 lib/Data/Internal/XIO.hs                      |  23 ++-
 .../Internal/DBus/Brightness/ClevoKeyboard.hs |  18 +-
 lib/XMonad/Internal/DBus/Brightness/Common.hs |  48 +++---
 .../DBus/Brightness/IntelBacklight.hs         |  18 +-
 lib/XMonad/Internal/DBus/Removable.hs         |  23 ++-
 lib/XMonad/Internal/DBus/Screensaver.hs       |  26 ++-
 lib/Xmobar/Plugins/BacklightCommon.hs         |  10 +-
 lib/Xmobar/Plugins/Bluetooth.hs               | 140 +++++++++------
 lib/Xmobar/Plugins/Common.hs                  |  17 +-
 lib/Xmobar/Plugins/Device.hs                  |  28 +--
 lib/Xmobar/Plugins/Screensaver.hs             |   7 +-
 lib/Xmobar/Plugins/VPN.hs                     |  66 +++++---
 13 files changed, 385 insertions(+), 199 deletions(-)

diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs
index 69651a1..18cc40e 100644
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
@@ -7,6 +9,10 @@ module Data.Internal.DBus
   ( SafeClient (..)
   , SysClient (..)
   , SesClient (..)
+  , DBusEnv (..)
+  , DIO
+  , HasClient (..)
+  , withDIO
   , addMatchCallback
   , matchProperty
   , matchPropertyFull
@@ -102,26 +108,49 @@ getDBusClient' sys = do
       return Nothing
     Right c -> return $ Just c
 
+data DBusEnv env c = DBusEnv {dClient :: !c, dEnv :: !env}
+
+type DIO env c = RIO (DBusEnv env c)
+
+instance HasClient (DBusEnv SimpleApp) where
+  clientL = lens dClient (\x y -> x {dClient = y})
+
+instance SafeClient c => HasLogFunc (DBusEnv SimpleApp c) where
+  logFuncL = lens dEnv (\x y -> x {dEnv = y}) . logFuncL
+
+withDIO
+  :: (MonadUnliftIO m, MonadReader env m, SafeClient c)
+  => c
+  -> DIO env c a
+  -> m a
+withDIO cl x = do
+  env <- ask
+  runRIO (DBusEnv cl env) x
+
+class HasClient env where
+  clientL :: SafeClient c => Lens' (env c) c
+
 --------------------------------------------------------------------------------
 -- Methods
 
 type MethodBody = Either T.Text [Variant]
 
-callMethod' :: (MonadUnliftIO m, SafeClient c) => c -> MethodCall -> m MethodBody
-callMethod' cl =
-  liftIO
-    . fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
-    . call (toClient cl)
+callMethod'
+  :: (SafeClient c, MonadUnliftIO m, MonadReader (env c) m, HasClient env)
+  => MethodCall
+  -> m MethodBody
+callMethod' mc = do
+  cl <- toClient <$> view clientL
+  liftIO $ bimap (T.pack . methodErrorMessage) methodReturnBody <$> call cl mc
 
 callMethod
-  :: (MonadUnliftIO m, SafeClient c)
-  => c
-  -> BusName
+  :: (SafeClient c, MonadUnliftIO m, MonadReader (env c) m, HasClient env)
+  => BusName
   -> ObjectPath
   -> InterfaceName
   -> MemberName
   -> m MethodBody
-callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
+callMethod bus path iface = callMethod' . methodCallBus bus path iface
 
 methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
 methodCallBus b p i m =
@@ -136,12 +165,16 @@ dbusInterface :: InterfaceName
 dbusInterface = interfaceName_ "org.freedesktop.DBus"
 
 callGetNameOwner
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
-  => c
-  -> BusName
+  :: ( SafeClient c
+     , MonadUnliftIO m
+     , MonadReader (env c) m
+     , HasClient env
+     , HasLogFunc (env c)
+     )
+  => BusName
   -> m (Maybe BusName)
-callGetNameOwner cl name = do
-  res <- callMethod' cl mc
+callGetNameOwner name = do
+  res <- callMethod' mc
   case res of
     Left err -> do
       logError $ Utf8Builder $ encodeUtf8Builder err
@@ -170,13 +203,19 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant
 type SignalCallback m = [Variant] -> m ()
 
 addMatchCallback
-  :: (MonadUnliftIO m, SafeClient c)
+  :: ( MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     , SafeClient c
+     , HasClient env
+     )
   => MatchRule
   -> SignalCallback m
-  -> c
   -> m SignalHandler
-addMatchCallback rule cb cl = withRunInIO $ \run -> do
-  addMatch (toClient cl) rule $ run . cb . signalBody
+addMatchCallback rule cb = do
+  cl <- toClient <$> view clientL
+  withRunInIO $ \run -> do
+    addMatch cl rule $ run . cb . signalBody
 
 matchSignal
   :: Maybe BusName
@@ -193,15 +232,19 @@ matchSignal b p i m =
     }
 
 matchSignalFull
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
-  => c
-  -> BusName
+  :: ( MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     , SafeClient c
+     , HasClient env
+     )
+  => BusName
   -> Maybe ObjectPath
   -> Maybe InterfaceName
   -> Maybe MemberName
   -> m (Maybe MatchRule)
-matchSignalFull client b p i m = do
-  res <- callGetNameOwner client b
+matchSignalFull b p i m = do
+  res <- callGetNameOwner b
   case res of
     Just o -> return $ Just $ matchSignal (Just o) p i m
     Nothing -> do
@@ -229,15 +272,20 @@ propertySignal :: MemberName
 propertySignal = memberName_ "PropertiesChanged"
 
 callPropertyGet
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
+  :: ( HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     , SafeClient c
+     )
   => BusName
   -> ObjectPath
   -> InterfaceName
   -> MemberName
-  -> c
   -> m [Variant]
-callPropertyGet bus path iface property cl = do
-  res <- liftIO $ getProperty (toClient cl) $ methodCallBus bus path iface property
+callPropertyGet bus path iface property = do
+  cl <- toClient <$> view clientL
+  res <- liftIO $ getProperty cl $ methodCallBus bus path iface property
   case res of
     Left err -> do
       logError $ displayBytesUtf8 $ BC.pack $ methodErrorMessage err
@@ -249,13 +297,17 @@ matchProperty b p =
   matchSignal b p (Just propertyInterface) (Just propertySignal)
 
 matchPropertyFull
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
-  => c
-  -> BusName
+  :: ( MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     , SafeClient c
+     , HasClient env
+     )
+  => BusName
   -> Maybe ObjectPath
   -> m (Maybe MatchRule)
-matchPropertyFull cl b p =
-  matchSignalFull cl b p (Just propertyInterface) (Just propertySignal)
+matchPropertyFull b p =
+  matchSignalFull b p (Just propertyInterface) (Just propertySignal)
 
 data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show)
 
@@ -301,13 +353,17 @@ omInterfacesRemoved :: MemberName
 omInterfacesRemoved = memberName_ "InterfacesRemoved"
 
 callGetManagedObjects
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
-  => c
-  -> BusName
+  :: ( MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     , SafeClient c
+     , HasClient env
+     )
+  => BusName
   -> ObjectPath
   -> m ObjectTree
-callGetManagedObjects cl bus path = do
-  res <- callMethod cl bus path omInterface getManagedObjects
+callGetManagedObjects bus path = do
+  res <- callMethod bus path omInterface getManagedObjects
   case res of
     Left err -> do
       logError $ Utf8Builder $ encodeUtf8Builder err
@@ -315,15 +371,19 @@ callGetManagedObjects cl bus path = do
     Right v -> return $ fromMaybe M.empty $ fromSingletonVariant v
 
 addInterfaceChangedListener
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
+  :: ( MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     , SafeClient c
+     , HasClient env
+     )
   => BusName
   -> MemberName
   -> ObjectPath
   -> SignalCallback m
-  -> c
   -> m (Maybe SignalHandler)
-addInterfaceChangedListener bus prop path sc cl = do
-  res <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
+addInterfaceChangedListener bus prop path sc = do
+  res <- matchSignalFull bus (Just path) (Just omInterface) (Just prop)
   case res of
     Nothing -> do
       logError $
@@ -334,28 +394,36 @@ addInterfaceChangedListener bus prop path sc cl = do
           <> " on bus "
           <> bus_
       return Nothing
-    Just rule -> Just <$> addMatchCallback rule sc cl
+    Just rule -> Just <$> addMatchCallback rule sc
   where
     bus_ = "'" <> displayBusName bus <> "'"
     path_ = "'" <> displayObjectPath path <> "'"
     prop_ = "'" <> displayMemberName prop <> "'"
 
 addInterfaceAddedListener
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
+  :: ( MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     , SafeClient c
+     , HasClient env
+     )
   => BusName
   -> ObjectPath
   -> SignalCallback m
-  -> c
   -> m (Maybe SignalHandler)
 addInterfaceAddedListener bus =
   addInterfaceChangedListener bus omInterfacesAdded
 
 addInterfaceRemovedListener
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
+  :: ( MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     , SafeClient c
+     , HasClient env
+     )
   => BusName
   -> ObjectPath
   -> SignalCallback m
-  -> c
   -> m (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
   addInterfaceChangedListener bus omInterfacesRemoved
diff --git a/lib/Data/Internal/XIO.hs b/lib/Data/Internal/XIO.hs
index e3bf816..005b8c4 100644
--- a/lib/Data/Internal/XIO.hs
+++ b/lib/Data/Internal/XIO.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -404,9 +406,15 @@ data XEnv = XEnv
 instance HasLogFunc XEnv where
   logFuncL = lens xLogFun (\x y -> x {xLogFun = y})
 
+instance SafeClient c => HasLogFunc (DBusEnv XEnv c) where
+  logFuncL = lens dEnv (\x y -> x {dEnv = y}) . logFuncL
+
 instance HasProcessContext XEnv where
   processContextL = lens xProcCxt (\x y -> x {xProcCxt = y})
 
+instance HasClient (DBusEnv XEnv) where
+  clientL = lens dClient (\x y -> x {dClient = y})
+
 data XParams = XParams
   { xpLogLevel :: LogLevel
   , xpFeatures :: XPFeatures
@@ -865,8 +873,8 @@ testDBusDep_ :: SafeClient c => c -> DBusDependency_ c -> XIO MResult_
 testDBusDep_ c d = memoizeMVar $ testDBusDepNoCache_ c d
 
 testDBusDepNoCache_ :: SafeClient c => c -> DBusDependency_ c -> XIO Result_
-testDBusDepNoCache_ cl (Bus _ bus) = io $ do
-  ret <- callMethod cl queryBus queryPath queryIface queryMem
+testDBusDepNoCache_ cl (Bus _ bus) = do
+  ret <- withDIO cl $ callMethod queryBus queryPath queryIface queryMem
   return $ case ret of
     Left e -> Left [Msg LevelError e]
     Right b ->
@@ -885,8 +893,10 @@ testDBusDepNoCache_ cl (Bus _ bus) = io $ do
     queryMem = memberName_ "ListNames"
     bodyGetNames [v] = fromMaybe [] $ fromVariant v :: [T.Text]
     bodyGetNames _ = []
-testDBusDepNoCache_ cl (Endpoint _ busname objpath iface mem) = io $ do
-  ret <- callMethod cl busname objpath introspectInterface introspectMethod
+testDBusDepNoCache_ cl (Endpoint _ busname objpath iface mem) = do
+  ret <-
+    withDIO cl $
+      callMethod busname objpath introspectInterface introspectMethod
   return $ case ret of
     Left e -> Left [Msg LevelError e]
     Right body -> procBody body
@@ -1001,8 +1011,9 @@ sometimesDBus
   -> Sometimes a
 sometimesDBus c fn n t x = sometimes1 fn n $ DBusRoot_ x t c
 
+-- TODO do I need to hardcode XEnv?
 sometimesEndpoint
-  :: (SafeClient c, MonadIO m)
+  :: (HasClient (DBusEnv env), SafeClient c, MonadReader env m, MonadUnliftIO m)
   => T.Text
   -> T.Text
   -> [Fulfillment]
@@ -1016,7 +1027,7 @@ sometimesEndpoint fn name ful busname path iface mem cl =
   sometimesDBus cl fn name deps cmd
   where
     deps = Only_ $ Endpoint ful busname path iface $ Method_ mem
-    cmd c = io $ void $ callMethod c busname path iface mem
+    cmd c = void $ withDIO c $ callMethod busname path iface mem
 
 --------------------------------------------------------------------------------
 -- Dependency Tree Constructors
diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
index 7495da2..a6796c5 100644
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
@@ -128,15 +129,24 @@ exportClevoKeyboard =
     [stateFileDep, brightnessFileDep]
     clevoKeyboardConfig
 
-clevoKeyboardControls :: MonadUnliftIO m => Maybe SesClient -> BrightnessControls m
+clevoKeyboardControls
+  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
+  => Maybe SesClient
+  -> BrightnessControls m
 clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
 
-callGetBrightnessCK :: MonadUnliftIO m => SesClient -> m (Maybe Brightness)
+callGetBrightnessCK
+  :: (SafeClient c, HasClient env, MonadReader (env c) m, MonadUnliftIO m)
+  => m (Maybe Brightness)
 callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
 
 matchSignalCK
-  :: MonadUnliftIO m
+  :: ( SafeClient c
+     , HasLogFunc (env c)
+     , HasClient env
+     , MonadReader (env c) m
+     , MonadUnliftIO m
+     )
   => (Maybe Brightness -> m ())
-  -> SesClient
   -> m ()
 matchSignalCK = matchSignal clevoKeyboardConfig
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 4ef5e9d..f0cf6dd 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -22,7 +23,6 @@ import Data.Internal.DBus
 import Data.Internal.XIO
 import RIO
 import qualified RIO.Text as T
-import XMonad.Core (io)
 import XMonad.Internal.DBus.Common
 
 --------------------------------------------------------------------------------
@@ -54,7 +54,7 @@ data BrightnessControls m = BrightnessControls
   }
 
 brightnessControls
-  :: MonadUnliftIO m
+  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
   => XPQuery
   -> BrightnessConfig m a b
   -> Maybe SesClient
@@ -70,26 +70,35 @@ brightnessControls q bc cl =
     cb = callBacklight q cl bc
 
 callGetBrightness
-  :: (MonadUnliftIO m, SafeClient c, Num n)
+  :: ( HasClient env
+     , MonadReader (env c) m
+     , MonadUnliftIO m
+     , SafeClient c
+     , Num n
+     )
   => BrightnessConfig m a b
-  -> c
   -> m (Maybe n)
-callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} client =
+callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} =
   either (const Nothing) bodyGetBrightness
-    <$> callMethod client xmonadBusName p i memGet
+    <$> callMethod xmonadBusName p i memGet
 
 signalDep :: BrightnessConfig m a b -> DBusDependency_ SesClient
 signalDep BrightnessConfig {bcPath = p, bcInterface = i} =
   Endpoint [] xmonadBusName p i $ Signal_ memCur
 
 matchSignal
-  :: (MonadUnliftIO m, SafeClient c, Num n)
+  :: ( HasClient env
+     , HasLogFunc (env c)
+     , MonadReader (env c) m
+     , MonadUnliftIO m
+     , SafeClient c
+     , Num n
+     )
   => BrightnessConfig m a b
   -> (Maybe n -> m ())
-  -> c
   -> m ()
 matchSignal BrightnessConfig {bcPath = p, bcInterface = i} cb =
-  void . addMatchCallback brMatcher (cb . bodyGetBrightness)
+  void $ addMatchCallback brMatcher (cb . bodyGetBrightness)
   where
     -- TODO add busname to this
     brMatcher =
@@ -166,27 +175,18 @@ emitBrightness BrightnessConfig {bcPath = p, bcInterface = i} client cur =
     sig = signal p i memCur
 
 callBacklight
-  :: MonadUnliftIO m
+  :: (MonadReader env m, HasClient (DBusEnv env), MonadUnliftIO m)
   => XPQuery
   -> Maybe SesClient
   -> BrightnessConfig m a b
   -> T.Text
   -> MemberName
   -> Sometimes (m ())
-callBacklight
-  q
-  cl
-  BrightnessConfig
-    { bcPath = p
-    , bcInterface = i
-    , bcName = n
-    }
-  controlName
-  m =
-    Sometimes (T.unwords [n, controlName]) q [Subfeature root "method call"]
-    where
-      root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
-      cmd c = io $ void $ callMethod c xmonadBusName p i m
+callBacklight q cl BrightnessConfig {bcPath = p, bcInterface = i, bcName = n} controlName m =
+  Sometimes (T.unwords [n, controlName]) q [Subfeature root "method call"]
+  where
+    root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
+    cmd c = void $ withDIO c $ callMethod xmonadBusName p i m
 
 bodyGetBrightness :: Num a => [Variant] -> Maybe a
 bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index b4ea2ec..eaf0a18 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
@@ -114,15 +115,24 @@ exportIntelBacklight =
     [curFileDep, maxFileDep]
     intelBacklightConfig
 
-intelBacklightControls :: MonadUnliftIO m => Maybe SesClient -> BrightnessControls m
+intelBacklightControls
+  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
+  => Maybe SesClient
+  -> BrightnessControls m
 intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig
 
-callGetBrightnessIB :: MonadUnliftIO m => SesClient -> m (Maybe Brightness)
+callGetBrightnessIB
+  :: (SafeClient c, HasClient env, MonadReader (env c) m, MonadUnliftIO m)
+  => m (Maybe Brightness)
 callGetBrightnessIB = callGetBrightness intelBacklightConfig
 
 matchSignalIB
-  :: MonadUnliftIO m
+  :: ( SafeClient c
+     , HasLogFunc (env c)
+     , HasClient env
+     , MonadReader (env c) m
+     , MonadUnliftIO m
+     )
   => (Maybe Brightness -> m ())
-  -> SesClient
   -> m ()
 matchSignalIB = matchSignal intelBacklightConfig
diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs
index 1a228c1..2879465 100644
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
@@ -80,17 +81,31 @@ playSoundMaybe p b = when b $ io $ playSound p
 -- If it not already, we won't see any signals from the dbus until it is
 -- started (it will work after it is started however). It seems safe to simply
 -- enable the udisks2 service at boot; however this is not default behavior.
-listenDevices :: MonadUnliftIO m => SysClient -> m ()
+listenDevices
+  :: ( HasClient (DBusEnv env)
+     , HasLogFunc (DBusEnv env SysClient)
+     , MonadReader env m
+     , MonadUnliftIO m
+     )
+  => SysClient
+  -> m ()
 listenDevices cl = do
   addMatch' memAdded driveInsertedSound addedHasDrive
   addMatch' memRemoved driveRemovedSound removedHasDrive
   where
     addMatch' m p f = do
       let rule = ruleUdisks {matchMember = Just m}
-      void $ addMatchCallback rule (playSoundMaybe p . f) cl
+      void $ withDIO cl $ addMatchCallback rule (playSoundMaybe p . f)
 
-runRemovableMon :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
+runRemovableMon
+  :: ( HasClient (DBusEnv env)
+     , HasLogFunc (DBusEnv env SysClient)
+     , MonadReader env m
+     , MonadUnliftIO m
+     )
+  => Maybe SysClient
+  -> Sometimes (m ())
 runRemovableMon cl =
-  sometimesDBus cl "removeable device monitor" "dbus monitor" deps $ io . listenDevices
+  sometimesDBus cl "removeable device monitor" "dbus monitor" deps listenDevices
   where
     deps = toAnd_ addedDep removedDep
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index 96e1ca8..541d096 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
@@ -124,7 +125,10 @@ exportScreensaver ses =
     bus = Bus [] xmonadBusName
     ssx = DBusIO $ sysExe [Package Official "xorg-xset"] ssExecutable
 
-callToggle :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
+callToggle
+  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
+  => Maybe SesClient
+  -> Sometimes (m ())
 callToggle =
   sometimesEndpoint
     "screensaver toggle"
@@ -135,18 +139,26 @@ callToggle =
     interface
     memToggle
 
-callQuery :: MonadUnliftIO m => SesClient -> m (Maybe SSState)
-callQuery ses = do
-  reply <- callMethod ses xmonadBusName ssPath interface memQuery
+callQuery
+  :: (HasClient env, MonadReader (env SesClient) m, MonadUnliftIO m)
+  => m (Maybe SSState)
+callQuery = do
+  reply <- callMethod xmonadBusName ssPath interface memQuery
   return $ either (const Nothing) bodyGetCurrentState reply
 
-matchSignal :: MonadUnliftIO m => (Maybe SSState -> m ()) -> SesClient -> m ()
-matchSignal cb ses =
+matchSignal
+  :: ( HasLogFunc (env SesClient)
+     , HasClient env
+     , MonadReader (env SesClient) m
+     , MonadUnliftIO m
+     )
+  => (Maybe SSState -> m ())
+  -> m ()
+matchSignal cb =
   void $
     addMatchCallback
       ruleCurrentState
       (cb . bodyGetCurrentState)
-      ses
 
 ssSignalDep :: DBusDependency_ SesClient
 ssSignalDep = Endpoint [] xmonadBusName ssPath interface $ Signal_ memState
diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs
index 14c8e4c..867e13f 100644
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@@ -14,15 +14,15 @@ import Xmobar.Plugins.Common
 startBacklight
   :: (MonadUnliftIO m, RealFrac a)
   => Utf8Builder
-  -> ((Maybe a -> RIO SimpleApp ()) -> SesClient -> RIO SimpleApp ())
-  -> (SesClient -> RIO SimpleApp (Maybe a))
+  -> ((Maybe a -> DIO SimpleApp SesClient ()) -> DIO SimpleApp SesClient ())
+  -> DIO SimpleApp SesClient (Maybe a)
   -> T.Text
   -> Callback
   -> m ()
 startBacklight name matchSignal callGetBrightness icon cb = do
-  withDBusClientConnection cb name $ \c -> do
-    matchSignal dpy c
-    dpy =<< callGetBrightness c
+  withDBusClientConnection cb name $ \c -> withDIO c $ do
+    matchSignal dpy
+    dpy =<< callGetBrightness
   where
     formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"]
     dpy = displayMaybe cb formatBrightness
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index ef70c68..4666048 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -76,19 +76,19 @@ startAdapter
 startAdapter is cs cb cl = do
   state <- newMVar emptyState
   let dpy = displayIcon cb (iconFormatter is cs)
-  mapRIO (BTEnv state dpy) $ do
-    ot <- getBtObjectTree cl
+  mapRIO (BTEnv cl state dpy) $ do
+    ot <- getBtObjectTree
     case findAdapter ot of
       Nothing -> logError "could not find bluetooth adapter"
       Just adapter -> do
         -- set up adapter
-        initAdapter adapter cl
-        void $ addAdaptorListener adapter cl
+        initAdapter adapter
+        void $ addAdaptorListener adapter
         -- set up devices on the adapter (and listeners for adding/removing devices)
         let devices = findDevices adapter ot
-        addDeviceAddedListener adapter cl
-        addDeviceRemovedListener adapter cl
-        forM_ devices $ \d -> addAndInitDevice d cl
+        addDeviceAddedListener adapter
+        addDeviceRemovedListener adapter
+        forM_ devices $ \d -> addAndInitDevice d
         -- after setting things up, show the icon based on the initialized state
         dpy
 
@@ -121,16 +121,20 @@ iconFormatter (iconConn, iconDisc) cs powered connected =
 -- is to track the shared state of the bluetooth adaptor and its devices using
 -- an MVar.
 
-data BTEnv = BTEnv
-  { btState :: !(MVar BtState)
+data BTEnv c = BTEnv
+  { btClient :: !c
+  , btState :: !(MVar BtState)
   , btDisplay :: !(BTIO ())
   , btEnv :: !SimpleApp
   }
 
-instance HasLogFunc BTEnv where
+instance HasClient BTEnv where
+  clientL = lens btClient (\x y -> x {btClient = y})
+
+instance HasLogFunc (BTEnv a) where
   logFuncL = lens btEnv (\x y -> x {btEnv = y}) . logFuncL
 
-type BTIO = RIO BTEnv
+type BTIO = RIO (BTEnv SysClient)
 
 data BTDevice = BTDevice
   { btDevConnected :: Maybe Bool
@@ -183,34 +187,43 @@ splitPathNoRoot :: ObjectPath -> [FilePath]
 splitPathNoRoot = dropWhile (== "/") . splitDirectories . formatObjectPath
 
 getBtObjectTree
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => SysClient
-  -> m ObjectTree
-getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
+  :: ( HasClient env
+     , SafeClient c
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
+  => m ObjectTree
+getBtObjectTree = callGetManagedObjects btBus btOMPath
 
 btOMPath :: ObjectPath
 btOMPath = objectPath_ "/"
 
 addBtOMListener
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  :: ( HasClient env
+     , SafeClient c
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
   => SignalCallback m
-  -> SysClient
   -> m ()
-addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
+addBtOMListener sc = void $ addInterfaceAddedListener btBus btOMPath sc
 
-addDeviceAddedListener :: ObjectPath -> SysClient -> BTIO ()
-addDeviceAddedListener adapter client = addBtOMListener addDevice client
+addDeviceAddedListener :: ObjectPath -> BTIO ()
+addDeviceAddedListener adapter = addBtOMListener addDevice
   where
     addDevice = pathCallback adapter $ \d ->
-      addAndInitDevice d client
+      addAndInitDevice d
 
-addDeviceRemovedListener :: ObjectPath -> SysClient -> BTIO ()
-addDeviceRemovedListener adapter sys =
-  addBtOMListener remDevice sys
+addDeviceRemovedListener :: ObjectPath -> BTIO ()
+addDeviceRemovedListener adapter =
+  addBtOMListener remDevice
   where
     remDevice = pathCallback adapter $ \d -> do
       old <- removeDevice d
-      forM_ old $ liftIO . removeMatch (toClient sys) . btDevSigHandler
+      cl <- asks btClient
+      forM_ old $ liftIO . removeMatch (toClient cl) . btDevSigHandler
 
 pathCallback :: ObjectPath -> (ObjectPath -> BTIO ()) -> SignalCallback BTIO
 pathCallback adapter f [device, _] = forM_ (fromVariant device) $ \d -> do
@@ -220,9 +233,9 @@ pathCallback _ _ _ = return ()
 --------------------------------------------------------------------------------
 -- Adapter
 
-initAdapter :: ObjectPath -> SysClient -> BTIO ()
-initAdapter adapter client = do
-  reply <- callGetPowered adapter client
+initAdapter :: ObjectPath -> BTIO ()
+initAdapter adapter = do
+  reply <- callGetPowered adapter
   logInfo $ "initializing adapter at path " <> adapter_
   -- TODO this could fail if the variant is something weird; the only
   -- indication I will get is "NA"
@@ -231,24 +244,33 @@ initAdapter adapter client = do
     adapter_ = displayWrapQuote $ displayObjectPath adapter
 
 matchBTProperty
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => SysClient
-  -> ObjectPath
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
+  => ObjectPath
   -> m (Maybe MatchRule)
-matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
+matchBTProperty p = matchPropertyFull btBus (Just p)
 
 withBTPropertyRule
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, IsVariant a)
-  => SysClient
-  -> ObjectPath
+  :: ( SafeClient c
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , HasClient env
+     , MonadUnliftIO m
+     , IsVariant a
+     )
+  => ObjectPath
   -> (Maybe a -> m ())
   -> InterfaceName
   -> T.Text
   -> m (Maybe SignalHandler)
-withBTPropertyRule cl path update iface prop = do
-  res <- matchBTProperty cl path
+withBTPropertyRule path update iface prop = do
+  res <- matchBTProperty path
   case res of
-    Just rule -> Just <$> addMatchCallback rule (signalToUpdate . matchConnected) cl
+    Just rule -> Just <$> addMatchCallback rule (signalToUpdate . matchConnected)
     Nothing -> do
       logError $
         "could not add listener for prop "
@@ -262,16 +284,20 @@ withBTPropertyRule cl path update iface prop = do
     signalToUpdate = withSignalMatch update
     matchConnected = matchPropertyChanged iface prop
 
-addAdaptorListener :: ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
-addAdaptorListener adaptor sys =
-  withBTPropertyRule sys adaptor procMatch adapterInterface adaptorPowered
+addAdaptorListener :: ObjectPath -> BTIO (Maybe SignalHandler)
+addAdaptorListener adaptor =
+  withBTPropertyRule adaptor procMatch adapterInterface adaptorPowered
   where
     procMatch = beforeDisplay . putPowered
 
 callGetPowered
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  :: ( HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , SafeClient c
+     , MonadUnliftIO m
+     )
   => ObjectPath
-  -> SysClient
   -> m [Variant]
 callGetPowered adapter =
   callPropertyGet btBus adapter adapterInterface $
@@ -293,20 +319,20 @@ adaptorPowered = "Powered"
 --------------------------------------------------------------------------------
 -- Devices
 
-addAndInitDevice :: ObjectPath -> SysClient -> BTIO ()
-addAndInitDevice device client = do
-  res <- addDeviceListener device client
+addAndInitDevice :: ObjectPath -> BTIO ()
+addAndInitDevice device = do
+  res <- addDeviceListener device
   case res of
     Just handler -> do
       logInfo $ "initializing device at path " <> device_
-      initDevice handler device client
+      initDevice handler device
     Nothing -> logError $ "could not initialize device at path " <> device_
   where
     device_ = displayWrapQuote $ displayObjectPath device
 
-initDevice :: SignalHandler -> ObjectPath -> SysClient -> BTIO ()
-initDevice sh device sys = do
-  reply <- callGetConnected device sys
+initDevice :: SignalHandler -> ObjectPath -> BTIO ()
+initDevice sh device = do
+  reply <- callGetConnected device
   void $
     insertDevice device $
       BTDevice
@@ -314,16 +340,20 @@ initDevice sh device sys = do
         , btDevSigHandler = sh
         }
 
-addDeviceListener :: ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
-addDeviceListener device sys =
-  withBTPropertyRule sys device procMatch devInterface devConnected
+addDeviceListener :: ObjectPath -> BTIO (Maybe SignalHandler)
+addDeviceListener device =
+  withBTPropertyRule device procMatch devInterface devConnected
   where
     procMatch = beforeDisplay . void . updateDevice device
 
 callGetConnected
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
   => ObjectPath
-  -> SysClient
   -> m [Variant]
 callGetConnected p =
   callPropertyGet btBus p devInterface $
diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs
index aaabde7..0fe2a31 100644
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@@ -32,18 +32,23 @@ data Colors = Colors
   deriving (Eq, Show, Read)
 
 startListener
-  :: (MonadUnliftIO m, SafeClient c, IsVariant a)
+  :: ( HasLogFunc (env c)
+     , HasClient env
+     , MonadReader (env c) m
+     , MonadUnliftIO m
+     , SafeClient c
+     , IsVariant a
+     )
   => MatchRule
-  -> (c -> m [Variant])
+  -> m [Variant]
   -> ([Variant] -> SignalMatch a)
   -> (a -> m T.Text)
   -> Callback
-  -> c
   -> m ()
-startListener rule getProp fromSignal toColor cb client = do
-  reply <- getProp client
+startListener rule getProp fromSignal toColor cb = do
+  reply <- getProp
   displayMaybe cb toColor $ fromSingletonVariant reply
-  void $ addMatchCallback rule (procMatch . fromSignal) client
+  void $ addMatchCallback rule (procMatch . fromSignal)
   where
     procMatch = procSignalMatch cb toColor
 
diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index 3ce53fc..89ae361 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 --------------------------------------------------------------------------------
 -- Device plugin
@@ -44,8 +45,11 @@ devDep =
   Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
     Method_ getByIP
 
-getDevice :: MonadUnliftIO m => SysClient -> T.Text -> m (Maybe ObjectPath)
-getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
+getDevice
+  :: (SafeClient c, HasClient env, MonadReader (env c) m, MonadUnliftIO m)
+  => T.Text
+  -> m (Maybe ObjectPath)
+getDevice iface = bodyToMaybe <$> callMethod' mc
   where
     mc =
       (methodCallBus networkManagerBus nmPath nmInterface getByIP)
@@ -53,9 +57,13 @@ getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
         }
 
 getDeviceConnected
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
   => ObjectPath
-  -> SysClient
   -> m [Variant]
 getDeviceConnected path =
   callPropertyGet networkManagerBus path nmDeviceInterface $
@@ -68,14 +76,14 @@ matchStatus = matchPropertyChanged nmDeviceInterface devSignal
 instance Exec Device where
   alias (Device (iface, _, _)) = T.unpack iface
   start (Device (iface, text, colors)) cb =
-    withDBusClientConnection cb logName $ \sys -> do
-      path <- getDevice sys iface
-      displayMaybe' cb (listener sys) path
+    withDBusClientConnection cb logName $ \(sys :: SysClient) -> withDIO sys $ do
+      path <- getDevice iface
+      displayMaybe' cb listener path
     where
       logName = "device@" <> Utf8Builder (encodeUtf8Builder iface)
-      listener sys path = do
-        res <- matchPropertyFull sys networkManagerBus (Just path)
+      listener path = do
+        res <- matchPropertyFull networkManagerBus (Just path)
         case res of
-          Just rule -> startListener rule (getDeviceConnected path) matchStatus chooseColor' cb sys
+          Just rule -> startListener rule (getDeviceConnected path) matchStatus chooseColor' cb
           Nothing -> logError "could not start listener"
       chooseColor' = return . (\s -> colorText colors s text) . (> 1)
diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs
index 8c333b7..457ec2a 100644
--- a/lib/Xmobar/Plugins/Screensaver.hs
+++ b/lib/Xmobar/Plugins/Screensaver.hs
@@ -12,6 +12,7 @@ module Xmobar.Plugins.Screensaver
   )
 where
 
+import Data.Internal.DBus
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Screensaver
 import Xmobar
@@ -25,8 +26,8 @@ ssAlias = "screensaver"
 instance Exec Screensaver where
   alias (Screensaver _) = T.unpack ssAlias
   start (Screensaver (text, colors)) cb =
-    withDBusClientConnection cb "screensaver" $ \sys -> do
-      matchSignal dpy sys
-      dpy =<< callQuery sys
+    withDBusClientConnection cb "screensaver" $ \cl -> withDIO cl $ do
+      matchSignal dpy
+      dpy =<< callQuery
     where
       dpy = displayMaybe cb $ return . (\s -> colorText colors s text)
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index b7b52df..fa054fa 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
@@ -32,11 +33,12 @@ instance Exec VPN where
   alias (VPN _) = T.unpack vpnAlias
   start (VPN (text, colors)) cb =
     withDBusClientConnection cb "VPN" $ \c -> do
-      state <- initState c
       let dpy = displayMaybe cb iconFormatter . Just =<< readState
-      mapRIO (VEnv state dpy) $ do
-        vpnAddedListener addedCallback c
-        vpnRemovedListener removedCallback c
+      s <- newMVar S.empty
+      mapRIO (VEnv c s dpy) $ do
+        initState
+        vpnAddedListener addedCallback
+        vpnRemovedListener removedCallback
         dpy
     where
       iconFormatter b = return $ colorText colors b text
@@ -48,28 +50,30 @@ instance Exec VPN where
 -- this will be a null or singleton set, but this setup could handle the edge
 -- case of multiple VPNs being active at once without puking.
 
-data VEnv = VEnv
-  { vState :: !MutableVPNState
+data VEnv c = VEnv
+  { vClient :: !c
+  , vState :: !MutableVPNState
   , vDisplay :: !(VIO ())
   , vEnv :: !SimpleApp
   }
 
-instance HasLogFunc VEnv where
+instance HasLogFunc (VEnv SysClient) where
   logFuncL = lens vEnv (\x y -> x {vEnv = y}) . logFuncL
 
-type VIO = RIO VEnv
+instance HasClient VEnv where
+  clientL = lens vClient (\x y -> x {vClient = y})
+
+type VIO = RIO (VEnv SysClient)
 
 type VPNState = S.Set ObjectPath
 
 type MutableVPNState = MVar VPNState
 
-initState
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => SysClient
-  -> m MutableVPNState
-initState client = do
-  ot <- getVPNObjectTree client
-  newMVar $ findTunnels ot
+initState :: VIO ()
+initState = do
+  ot <- getVPNObjectTree
+  s <- asks vState
+  putMVar s $ findTunnels ot
 
 readState :: VIO Bool
 readState = fmap (not . null) . readMVar =<< asks vState
@@ -86,27 +90,39 @@ beforeDisplay f = f >> join (asks vDisplay)
 -- Tunnel Device Detection
 
 getVPNObjectTree
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => SysClient
-  -> m ObjectTree
-getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
+  => m ObjectTree
+getVPNObjectTree = callGetManagedObjects vpnBus vpnPath
 
 findTunnels :: ObjectTree -> VPNState
 findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
 
 vpnAddedListener
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
   => SignalCallback m
-  -> SysClient
   -> m ()
-vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
+vpnAddedListener cb = void $ addInterfaceAddedListener vpnBus vpnPath cb
 
 vpnRemovedListener
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
   => SignalCallback m
-  -> SysClient
   -> m ()
-vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
+vpnRemovedListener cb = void $ addInterfaceRemovedListener vpnBus vpnPath cb
 
 addedCallback :: SignalCallback VIO
 addedCallback [device, added] =

From 003b0ce93784ced4c192c89b5522582c9db75a36 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 3 Jan 2023 22:28:34 -0500
Subject: [PATCH 113/118] FIX vpn state init

---
 lib/Xmobar/Plugins/VPN.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index fa054fa..dfd4905 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -34,7 +34,7 @@ instance Exec VPN where
   start (VPN (text, colors)) cb =
     withDBusClientConnection cb "VPN" $ \c -> do
       let dpy = displayMaybe cb iconFormatter . Just =<< readState
-      s <- newMVar S.empty
+      s <- newEmptyMVar
       mapRIO (VEnv c s dpy) $ do
         initState
         vpnAddedListener addedCallback

From 0d024ab649f3f74ee16f2c6d7dbfb2bfc67064a8 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 3 Jan 2023 22:31:29 -0500
Subject: [PATCH 114/118] REF clean up type alias

---
 lib/Xmobar/Plugins/VPN.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index dfd4905..a4283db 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -52,7 +52,7 @@ instance Exec VPN where
 
 data VEnv c = VEnv
   { vClient :: !c
-  , vState :: !MutableVPNState
+  , vState :: !(MVar VPNState)
   , vDisplay :: !(VIO ())
   , vEnv :: !SimpleApp
   }
@@ -67,8 +67,6 @@ type VIO = RIO (VEnv SysClient)
 
 type VPNState = S.Set ObjectPath
 
-type MutableVPNState = MVar VPNState
-
 initState :: VIO ()
 initState = do
   ot <- getVPNObjectTree

From a61b17502d2d3259333115a55adf17f0ad2f228b Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 3 Jan 2023 22:32:43 -0500
Subject: [PATCH 115/118] REF generalize typeclass

---
 lib/Xmobar/Plugins/VPN.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index a4283db..037420c 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -57,7 +57,7 @@ data VEnv c = VEnv
   , vEnv :: !SimpleApp
   }
 
-instance HasLogFunc (VEnv SysClient) where
+instance SafeClient c => HasLogFunc (VEnv c) where
   logFuncL = lens vEnv (\x y -> x {vEnv = y}) . logFuncL
 
 instance HasClient VEnv where

From 6c3d8c3eaf4f76180238876a10f1e03abc0e443d Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 3 Jan 2023 23:10:09 -0500
Subject: [PATCH 116/118] ENH use log file instead of stderr

---
 bin/xmobar.hs            |  2 +-
 bin/xmonad.hs            |  2 +-
 lib/Data/Internal/XIO.hs | 17 +++++++++++++----
 3 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index ae5c4d8..39205a8 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -65,7 +65,7 @@ parseTest =
     (long "test" <> short 't' <> help "test dependencies without running")
 
 xio :: XOpts -> IO ()
-xio o = runXIO $
+xio o = runXIO "xmobar.log" $
   case o of
     XDeps -> printDeps
     XTest -> withDBus_ evalConfig
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 73193ef..b7f8b13 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -91,7 +91,7 @@ parseTest =
     (long "test" <> short 't' <> help "test dependencies without running")
 
 xio :: XOpts -> IO ()
-xio o = runXIO $
+xio o = runXIO "xmonad.log" $
   case o of
     XDeps -> printDeps
     XTest -> undefined
diff --git a/lib/Data/Internal/XIO.hs b/lib/Data/Internal/XIO.hs
index 005b8c4..dedf5b7 100644
--- a/lib/Data/Internal/XIO.hs
+++ b/lib/Data/Internal/XIO.hs
@@ -118,7 +118,7 @@ import qualified RIO.Text as T
 import System.Posix.Files
 import System.Process.Typed (nullStream)
 import UnliftIO.Environment
-import XMonad.Core (X, io)
+import XMonad.Core (X, dataDir, getDirectories, io)
 import XMonad.Internal.IO
 import XMonad.Internal.Shell hiding (proc, runProcess)
 import XMonad.Internal.Theme
@@ -131,9 +131,18 @@ import XMonad.Internal.Theme
 
 -- | Run feature evaluation(s) with the cache
 -- Currently there is no easy way to not use this (oh well)
-runXIO :: XIO a -> IO a
-runXIO x = do
-  logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle stderr False
+runXIO :: FilePath -> XIO a -> IO a
+runXIO logfile x = do
+  -- TODO this directory will not exist on a fresh system
+  p <- (</> logfile) . dataDir <$> getDirectories
+  catchIO (withFile p AppendMode $ runXIOInner x) $ \e -> do
+    print e
+    putStrLn "could not open log file, falling back to stderr"
+    runXIOInner x stderr
+
+runXIOInner :: XIO a -> Handle -> IO a
+runXIOInner x h = do
+  logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
   pc <- mkDefaultProcessContext
   withLogFunc logOpts $ \f -> do
     p <- getParams

From 1142732dcad20672665f92ab623599c281190d70 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 3 Jan 2023 23:33:08 -0500
Subject: [PATCH 117/118] ENH log plugins in file

---
 lib/Data/Internal/XIO.hs              | 18 +++++++++++-------
 lib/Xmobar/Plugins/BacklightCommon.hs |  2 +-
 lib/Xmobar/Plugins/Bluetooth.hs       |  2 +-
 lib/Xmobar/Plugins/ClevoKeyboard.hs   |  2 +-
 lib/Xmobar/Plugins/Common.hs          | 24 +++++++++++++++++-------
 lib/Xmobar/Plugins/Device.hs          |  2 +-
 lib/Xmobar/Plugins/IntelBacklight.hs  |  2 +-
 lib/Xmobar/Plugins/Screensaver.hs     |  2 +-
 lib/Xmobar/Plugins/VPN.hs             |  2 +-
 9 files changed, 35 insertions(+), 21 deletions(-)

diff --git a/lib/Data/Internal/XIO.hs b/lib/Data/Internal/XIO.hs
index dedf5b7..6813146 100644
--- a/lib/Data/Internal/XIO.hs
+++ b/lib/Data/Internal/XIO.hs
@@ -99,6 +99,7 @@ module Data.Internal.XIO
   , process
   -- misc
   , shellTest
+  , withLogFile
   )
 where
 
@@ -132,16 +133,19 @@ import XMonad.Internal.Theme
 -- | Run feature evaluation(s) with the cache
 -- Currently there is no easy way to not use this (oh well)
 runXIO :: FilePath -> XIO a -> IO a
-runXIO logfile x = do
-  -- TODO this directory will not exist on a fresh system
-  p <- (</> logfile) . dataDir <$> getDirectories
-  catchIO (withFile p AppendMode $ runXIOInner x) $ \e -> do
-    print e
-    putStrLn "could not open log file, falling back to stderr"
-    runXIOInner x stderr
+runXIO logfile x = withLogFile logfile $ runXIOInner x
+
+withLogFile :: MonadUnliftIO m => FilePath -> (Handle -> m a) -> m a
+withLogFile logfile f = do
+  p <- (</> logfile) . dataDir <$> liftIO getDirectories
+  catchIO (withFile p AppendMode f) $ \e -> do
+    liftIO $ print e
+    liftIO $ putStrLn "could not open log file, falling back to stderr"
+    f stderr
 
 runXIOInner :: XIO a -> Handle -> IO a
 runXIOInner x h = do
+  hSetBuffering h LineBuffering
   logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
   pc <- mkDefaultProcessContext
   withLogFunc logOpts $ \f -> do
diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs
index 867e13f..137928a 100644
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@@ -13,7 +13,7 @@ import Xmobar.Plugins.Common
 
 startBacklight
   :: (MonadUnliftIO m, RealFrac a)
-  => Utf8Builder
+  => Maybe FilePath
   -> ((Maybe a -> DIO SimpleApp SesClient ()) -> DIO SimpleApp SesClient ())
   -> DIO SimpleApp SesClient (Maybe a)
   -> T.Text
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index 4666048..3b396e0 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -65,7 +65,7 @@ data Bluetooth = Bluetooth Icons Colors deriving (Read, Show)
 instance Exec Bluetooth where
   alias (Bluetooth _ _) = T.unpack btAlias
   start (Bluetooth icons colors) cb =
-    withDBusClientConnection cb "bluetooth" $ startAdapter icons colors cb
+    withDBusClientConnection cb (Just "bluetooth.log") $ startAdapter icons colors cb
 
 startAdapter
   :: Icons
diff --git a/lib/Xmobar/Plugins/ClevoKeyboard.hs b/lib/Xmobar/Plugins/ClevoKeyboard.hs
index 7c0f99f..a4b8975 100644
--- a/lib/Xmobar/Plugins/ClevoKeyboard.hs
+++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs
@@ -25,4 +25,4 @@ ckAlias = "clevokeyboard"
 instance Exec ClevoKeyboard where
   alias (ClevoKeyboard _) = T.unpack ckAlias
   start (ClevoKeyboard icon) =
-    startBacklight "clevo keyboard" matchSignalCK callGetBrightnessCK icon
+    startBacklight (Just "clevo_kbd.log") matchSignalCK callGetBrightnessCK icon
diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs
index 0fe2a31..ee37da8 100644
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@@ -12,12 +12,14 @@ module Xmobar.Plugins.Common
   , displayMaybe
   , displayMaybe'
   , xmobarFGColor
+  , LogConf (..)
   )
 where
 
 import DBus
 import DBus.Client
 import Data.Internal.DBus
+import Data.Internal.XIO
 import RIO
 import qualified RIO.Text as T
 import XMonad.Hooks.DynamicLog (xmobarColor)
@@ -75,13 +77,21 @@ displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na)
 withDBusClientConnection
   :: (MonadUnliftIO m, SafeClient c)
   => Callback
-  -> Utf8Builder
+  -> Maybe FilePath
   -> (c -> RIO SimpleApp ())
   -> m ()
-withDBusClientConnection cb name f = do
-  logOpts <- setLogVerboseFormat True . setLogUseTime True . setLogFormat pre <$> logOptionsHandle stderr False
-  withLogFunc logOpts $ \lf -> do
-    env <- mkSimpleApp lf Nothing
-    runRIO env $ displayMaybe' cb f =<< getDBusClient
+withDBusClientConnection cb logfile f =
+  maybe (run stderr) (`withLogFile` run) logfile
   where
-    pre rest = "[" <> name <> " plugin] " <> rest
+    run h = do
+      logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
+      withLogFunc logOpts $ \lf -> do
+        env <- mkSimpleApp lf Nothing
+        runRIO env $ displayMaybe' cb f =<< getDBusClient
+
+data LogConf = LogConf
+  { lcLevel :: !LogLevel
+  , lcVerbose :: !Bool
+  , lcPath :: FilePath
+  }
+  deriving (Show, Read)
diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs
index 89ae361..7f5fe97 100644
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@@ -80,7 +80,7 @@ instance Exec Device where
       path <- getDevice iface
       displayMaybe' cb listener path
     where
-      logName = "device@" <> Utf8Builder (encodeUtf8Builder iface)
+      logName = Just $ T.unpack $ T.concat ["device@", iface, ".log"]
       listener path = do
         res <- matchPropertyFull networkManagerBus (Just path)
         case res of
diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs
index 6174fba..55f293e 100644
--- a/lib/Xmobar/Plugins/IntelBacklight.hs
+++ b/lib/Xmobar/Plugins/IntelBacklight.hs
@@ -25,4 +25,4 @@ blAlias = "intelbacklight"
 instance Exec IntelBacklight where
   alias (IntelBacklight _) = T.unpack blAlias
   start (IntelBacklight icon) =
-    startBacklight "intel backlight" matchSignalIB callGetBrightnessIB icon
+    startBacklight (Just "intel_backlight.log") matchSignalIB callGetBrightnessIB icon
diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs
index 457ec2a..5ac35fc 100644
--- a/lib/Xmobar/Plugins/Screensaver.hs
+++ b/lib/Xmobar/Plugins/Screensaver.hs
@@ -26,7 +26,7 @@ ssAlias = "screensaver"
 instance Exec Screensaver where
   alias (Screensaver _) = T.unpack ssAlias
   start (Screensaver (text, colors)) cb =
-    withDBusClientConnection cb "screensaver" $ \cl -> withDIO cl $ do
+    withDBusClientConnection cb (Just "screensaver.log") $ \cl -> withDIO cl $ do
       matchSignal dpy
       dpy =<< callQuery
     where
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index 037420c..e9c0652 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -32,7 +32,7 @@ newtype VPN = VPN (T.Text, Colors) deriving (Read, Show)
 instance Exec VPN where
   alias (VPN _) = T.unpack vpnAlias
   start (VPN (text, colors)) cb =
-    withDBusClientConnection cb "VPN" $ \c -> do
+    withDBusClientConnection cb (Just "vpn.log") $ \c -> do
       let dpy = displayMaybe cb iconFormatter . Just =<< readState
       s <- newEmptyMVar
       mapRIO (VEnv c s dpy) $ do

From 24f0f034f0c726a53bac4788ba97f72eda02d765 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 3 Jan 2023 23:44:52 -0500
Subject: [PATCH 118/118] ENH make logger print to stderr when running test
 commands

---
 bin/xmobar.hs                |  9 ++++-----
 bin/xmonad.hs                |  9 ++++-----
 lib/Data/Internal/XIO.hs     | 14 ++++++++++----
 lib/Xmobar/Plugins/Common.hs |  8 --------
 4 files changed, 18 insertions(+), 22 deletions(-)

diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 39205a8..b1a35e3 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -65,11 +65,10 @@ parseTest =
     (long "test" <> short 't' <> help "test dependencies without running")
 
 xio :: XOpts -> IO ()
-xio o = runXIO "xmobar.log" $
-  case o of
-    XDeps -> printDeps
-    XTest -> withDBus_ evalConfig
-    XRun -> run
+xio o = case o of
+  XDeps -> hRunXIO False stderr printDeps
+  XTest -> hRunXIO False stderr $ withDBus_ evalConfig
+  XRun -> runXIO "xmobar.log" run
 
 run :: XIO ()
 run = do
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index b7f8b13..917de35 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -91,11 +91,10 @@ parseTest =
     (long "test" <> short 't' <> help "test dependencies without running")
 
 xio :: XOpts -> IO ()
-xio o = runXIO "xmonad.log" $
-  case o of
-    XDeps -> printDeps
-    XTest -> undefined
-    XRun -> run
+xio o = case o of
+  XDeps -> hRunXIO False stderr printDeps
+  XTest -> undefined
+  XRun -> runXIO "xmonad.log" run
 
 run :: XIO ()
 run = do
diff --git a/lib/Data/Internal/XIO.hs b/lib/Data/Internal/XIO.hs
index 6813146..b516e6a 100644
--- a/lib/Data/Internal/XIO.hs
+++ b/lib/Data/Internal/XIO.hs
@@ -58,6 +58,7 @@ module Data.Internal.XIO
   -- testing
   , XIO
   , runXIO
+  , hRunXIO
   , evalFeature
   , executeSometimes
   , executeAlways
@@ -133,8 +134,9 @@ import XMonad.Internal.Theme
 -- | Run feature evaluation(s) with the cache
 -- Currently there is no easy way to not use this (oh well)
 runXIO :: FilePath -> XIO a -> IO a
-runXIO logfile x = withLogFile logfile $ runXIOInner x
+runXIO logfile x = withLogFile logfile $ \h -> hRunXIO True h x
 
+-- TODO use dhall to encode config file and log here to control the loglevel
 withLogFile :: MonadUnliftIO m => FilePath -> (Handle -> m a) -> m a
 withLogFile logfile f = do
   p <- (</> logfile) . dataDir <$> liftIO getDirectories
@@ -143,16 +145,20 @@ withLogFile logfile f = do
     liftIO $ putStrLn "could not open log file, falling back to stderr"
     f stderr
 
-runXIOInner :: XIO a -> Handle -> IO a
-runXIOInner x h = do
+hRunXIO :: Bool -> Handle -> XIO a -> IO a
+hRunXIO verbose h x = do
   hSetBuffering h LineBuffering
-  logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
+  logOpts <- logOptionsHandle_ verbose h
   pc <- mkDefaultProcessContext
   withLogFunc logOpts $ \f -> do
     p <- getParams
     let s = XEnv f pc p
     runRIO s x
 
+logOptionsHandle_ :: MonadUnliftIO m => Bool -> Handle -> m LogOptions
+logOptionsHandle_ v h =
+  setLogVerboseFormat v . setLogUseTime v <$> logOptionsHandle h False
+
 -- | Execute an Always immediately
 executeAlways :: Always (IO a) -> XIO a
 executeAlways = io <=< evalAlways
diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs
index ee37da8..abefb83 100644
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@@ -12,7 +12,6 @@ module Xmobar.Plugins.Common
   , displayMaybe
   , displayMaybe'
   , xmobarFGColor
-  , LogConf (..)
   )
 where
 
@@ -88,10 +87,3 @@ withDBusClientConnection cb logfile f =
       withLogFunc logOpts $ \lf -> do
         env <- mkSimpleApp lf Nothing
         runRIO env $ displayMaybe' cb f =<< getDBusClient
-
-data LogConf = LogConf
-  { lcLevel :: !LogLevel
-  , lcVerbose :: !Bool
-  , lcPath :: FilePath
-  }
-  deriving (Show, Read)