49 changed files with 941 additions and 993 deletions
--- a/bin/vbox-start.hs
+++ b/bin/vbox-start.hs
@ -1,3 +1,6 @@
 {-# 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
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | Xmobar binary
 --
 -- Features:
@ -11,14 +13,14 @@ module Main (main) where
 import Data.Internal.DBus
 import Data.Internal.XIO
 import GHC.Enum (enumFrom)
 import Options.Applicative
 import RIO hiding (hFlush)
-import RIO.FilePath
+import qualified RIO.ByteString.Lazy as BL
 import RIO.List
-import qualified RIO.NonEmpty as NE
+import RIO.Process
 import qualified RIO.Text as T
 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
@ -29,12 +31,13 @@ import Xmobar hiding
  ( iconOffset
  , run
  )
 import Xmobar.Plugins.ActiveConnection
 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 = parse >>= xio
@ -64,7 +67,7 @@ parseTest =
 xio :: XOpts -> IO ()
 xio o = case o of
  XDeps -> hRunXIO False stderr printDeps
-  XTest -> hRunXIO False stderr $ withDBus_ Nothing Nothing evalConfig
+  XTest -> hRunXIO False stderr $ withDBus_ evalConfig
  XRun -> runXIO "xmobar.log" run
 run :: XIO ()
@ -76,9 +79,9 @@ run = do
  -- linebuffering it usually only prints the first few characters (even then
  -- it only prints 10-20% of the time)
  liftIO $ hSetBuffering stderr LineBuffering
-  -- TODO do these dbus things really need to remain connected?
+  withDBus_ $ \db -> do
-  c <- withDBus Nothing Nothing evalConfig
+    c <- evalConfig db
-  liftIO $ xmobar c
+    liftIO $ xmobar c
 evalConfig :: DBusState -> XIO Config
 evalConfig db = do
@ -89,7 +92,7 @@ evalConfig db = do
  return $ config bf ifs ios cs d
 printDeps :: XIO ()
-printDeps = withDBus_ Nothing Nothing $ \db ->
+printDeps = withDBus_ $ \db ->
  mapM_ logInfo $
    fmap showFulfillment $
      sort $
@ -118,7 +121,7 @@ iconFont =
  fontSometimes
    "XMobar Icon Font"
    "Symbols Nerd Font"
-    [Package Official "ttf-nerd-fonts-symbols"]
+    [Package Official "ttf-nerd-fonts-symbols-2048-em"]
 -- | Offsets for the icons in the bar (relative to the text offset)
 iconOffset :: BarFont -> Int
@ -164,7 +167,7 @@ config bf ifs ios br confDir =
    , pickBroadest = False
    , persistent = True
    , -- store the icons with the xmonad/xmobar stack project
-      iconRoot = confDir </> "assets" </> "icons"
+      iconRoot = confDir ++ "/icons"
    , commands = csRunnable <$> concatRegions br
    }
@ -219,11 +222,11 @@ getWireless =
    xpfWireless
    [Subfeature (IORoot wirelessCmd $ Only readWireless) "sysfs path"]
-getEthernet :: Maybe NamedSysConnection -> BarFeature
+getEthernet :: Maybe SysClient -> BarFeature
-getEthernet cl = iconDBus_ "ethernet status indicator" xpfEthernet root (Only_ devDep)
+getEthernet cl = iconDBus "ethernet status indicator" xpfEthernet root tree
  where
-    root useIcon tree' =
+    root useIcon tree' = DBusRoot (const . ethernetCmd useIcon) tree' cl
-      DBusRoot_ (const $ ethernetCmd useIcon) tree' cl
+    tree = And1 (Only readEthernet) (Only_ devDep)
 getBattery :: BarFeature
 getBattery = iconIO_ "battery level indicator" xpfBattery root tree
@ -235,12 +238,18 @@ getBattery = iconIO_ "battery level indicator" xpfBattery root tree
          io $
            fmap (Msg LevelError) <$> hasBattery
-getVPN :: Maybe NamedSysConnection -> BarFeature
+getVPN :: Maybe SysClient -> BarFeature
-getVPN cl = iconDBus_ "VPN status indicator" xpfVPN root (Only_ devDep)
+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
-getBt :: Maybe NamedSysConnection -> BarFeature
+getBt :: Maybe SysClient -> BarFeature
 getBt = xmobarDBus "bluetooth status indicator" xpfBluetooth btDep btCmd
 getAlsa :: BarFeature
@ -251,7 +260,7 @@ getAlsa =
  where
    root useIcon = IORoot_ (alsaCmd useIcon)
-getBl :: Maybe NamedSesConnection -> BarFeature
+getBl :: Maybe SesClient -> BarFeature
 getBl =
  xmobarDBus
    "Intel backlight indicator"
@ -259,7 +268,7 @@ getBl =
    intelBacklightSignalDep
    blCmd
-getCk :: Maybe NamedSesConnection -> BarFeature
+getCk :: Maybe SesClient -> BarFeature
 getCk =
  xmobarDBus
    "Clevo keyboard indicator"
@ -267,7 +276,7 @@ getCk =
    clevoKeyboardSignalDep
    ckCmd
-getSs :: Maybe NamedSesConnection -> BarFeature
+getSs :: Maybe SesClient -> BarFeature
 getSs = xmobarDBus "screensaver indicator" (const True) ssSignalDep ssCmd
 getLock :: Always CmdSpec
@ -284,7 +293,7 @@ xmobarDBus
  -> XPQuery
  -> DBusDependency_ c
  -> (Fontifier -> CmdSpec)
-  -> Maybe (NamedConnection c)
+  -> Maybe c
  -> BarFeature
 xmobarDBus n q dep cmd cl = iconDBus_ n q root (Only_ dep)
  where
@ -298,16 +307,18 @@ iconIO_
  -> BarFeature
 iconIO_ = iconSometimes' And_ Only_
-- iconDBus
+iconDBus
--   :: T.Text
+  :: SafeClient c
--   -> XPQuery
+  => T.Text
--   -> (Fontifier -> DBusTree c p -> Root CmdSpec)
+  -> XPQuery
--   -> DBusTree c p
+  -> (Fontifier -> DBusTree c p -> Root CmdSpec)
--   -> BarFeature
+  -> DBusTree c p
-- iconDBus = iconSometimes' And1 $ Only_ . DBusIO
+  -> BarFeature
 iconDBus = iconSometimes' And1 $ Only_ . DBusIO
 iconDBus_
-  :: T.Text
+  :: SafeClient c
  => T.Text
  -> XPQuery
  -> (Fontifier -> DBusTree_ c -> Root CmdSpec)
  -> DBusTree_ c
@ -369,19 +380,13 @@ wirelessCmd iface =
        , "<icon=wifi_%%.xpm/>"
        ]
-ethernetCmd :: Fontifier -> CmdSpec
+ethernetCmd :: Fontifier -> T.Text -> CmdSpec
-ethernetCmd = connCmd "\xf0e8" "ETH" ("vlan" :| ["802-3-ethernet"])
+ethernetCmd fontify iface =
 vpnCmd :: Fontifier -> CmdSpec
 vpnCmd = connCmd "\xf023" "VPN" ("tun" :| [])
 connCmd :: T.Text -> T.Text -> NE.NonEmpty T.Text -> Fontifier -> CmdSpec
 connCmd icon abbr contypes fontify =
  CmdSpec
-    { csAlias = connAlias contypes
+    { csAlias = iface
    , csRunnable =
        Run $
-          ActiveConnection (contypes, fontify IconMedium icon abbr, colors)
+          Device (iface, fontify IconMedium "\xf0e8" "ETH", colors)
    }
 batteryCmd :: Fontifier -> CmdSpec
@ -417,13 +422,20 @@ batteryCmd fontify =
        , fontify' "\xf1e6" "AC"
        ]
 vpnCmd :: Fontifier -> CmdSpec
 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' "\x0f00b1" "+", fontify' "\x0f00af" "-") colors
+          Bluetooth (fontify' "\xf5b0" "+", fontify' "\xf5ae" "-") colors
    }
  where
    fontify' i = fontify IconLarge i . T.append "BT"
@ -464,7 +476,7 @@ ckCmd :: Fontifier -> CmdSpec
 ckCmd fontify =
  CmdSpec
    { csAlias = ckAlias
-    , csRunnable = Run $ ClevoKeyboard $ fontify IconSmall "\xf11c" "KB: "
+    , csRunnable = Run $ ClevoKeyboard $ fontify IconSmall "\xf40b" "KB: "
    }
 ssCmd :: Fontifier -> CmdSpec
@ -500,8 +512,8 @@ lockCmd fontify =
              ]
    }
  where
-    numIcon = fontify' "\x0f03a6" "N"
+    numIcon = fontify' "\xf8a5" "N"
-    capIcon = fontify' "\x0f0bf1" "C"
+    capIcon = fontify' "\xf657" "C"
    fontify' = fontify IconXLarge
    disabledColor = xmobarFGColor XT.backdropFgColor
@ -512,6 +524,29 @@ dateCmd =
    , csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
    }
 --------------------------------------------------------------------------------
 -- low-level testing functions
 vpnPresent :: XIO (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"]
 --------------------------------------------------------------------------------
 -- text font
 --
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@ -1,3 +1,9 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 --------------------------------------------------------------------------------
 --  XMonad binary
@ -21,7 +27,7 @@ import System.Process
  ( getPid
  , getProcessExitCode
  )
-import XMonad hiding (display)
+import XMonad
 import XMonad.Actions.CopyWindow
 import XMonad.Actions.CycleWS
 import XMonad.Actions.PhysicalScreens
@ -45,7 +51,6 @@ 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.Decoration
 import XMonad.Layout.MultiToggle
 import XMonad.Layout.NoBorders
 import XMonad.Layout.NoFrillsDecoration
@ -139,21 +144,21 @@ run = do
                        , normalBorderColor = T.unpack XT.bordersColor
                        , focusedBorderColor = T.unpack XT.selectedBordersColor
                        }
-          runXMonad conf
+          io $ runXMonad conf
  where
    startDynWorkspaces fs = do
      dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
      void $ async $ runWorkspaceMon dws
      return dws
-runXMonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> XIO ()
+runXMonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
 runXMonad conf = do
  dirs <- getCreateDirectories
-  liftIO $ launch conf dirs
+  launch conf dirs
-getCreateDirectories :: XIO Directories
+getCreateDirectories :: IO Directories
 getCreateDirectories = do
-  ds <- liftIO getDirectories
+  ds <- getDirectories
  mapM_ (createIfMissing ds) [dataDir, cfgDir, cacheDir]
  return ds
  where
@ -161,14 +166,14 @@ getCreateDirectories = do
      let d = f ds
      r <- tryIO $ createDirectoryIfMissing True d
      case r of
-        (Left e) -> logError $ display e
+        (Left e) -> print e
        _ -> return ()
 data FeatureSet = FeatureSet
  { fsKeys :: (XIO () -> IO ()) -> X () -> DBusState -> [KeyGroup FeatureX]
-  , fsDBusExporters :: [Maybe NamedSesConnection -> Sometimes (XIO (), XIO ())]
+  , fsDBusExporters :: [Maybe SesClient -> Sometimes (XIO (), XIO ())]
  , fsPowerMon :: SometimesIO
-  , fsRemovableMon :: Maybe NamedSysConnection -> SometimesIO
+  , fsRemovableMon :: Maybe SysClient -> SometimesIO
  , fsDaemons :: [Sometimes (XIO (Process () () ()))]
  , fsACPIHandler :: Always (String -> X ())
  , fsTabbedTheme :: Always Theme
@ -183,7 +188,7 @@ tabbedFeature = Always "theme for tabbed windows" $ Option sf fallback
    niceTheme = IORoot XT.tabbedTheme $ fontTree XT.defFontFamily defFontPkgs
    fallback = Always_ $ FallbackAlone $ XT.tabbedTheme XT.fallbackFont
-features :: Maybe NamedSysConnection -> FeatureSet
+features :: Maybe SysClient -> FeatureSet
 features cl =
  FeatureSet
    { fsKeys = externalBindings
@ -251,7 +256,7 @@ stopChildDaemons = mapM_ stop
      liftIO $ killNoWait p
 printDeps :: XIO ()
-printDeps = withDBus_ Nothing Nothing $ \db -> do
+printDeps = withDBus_ $ \db -> do
  runIO <- askRunInIO
  let mockCleanup = runCleanup runIO mockClean db
  let bfs =
@ -292,7 +297,7 @@ runCleanup runIO ts db = liftIO $ runIO $ do
  mapM_ stopXmobar $ clXmobar ts
  stopChildDaemons $ clChildren ts
  sequence_ $ clDBusUnexporters ts
-  disconnectDBus db
+  disconnectDBusX db
 -- | Kill a process (group) after xmonad has already started
 -- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad
@ -345,6 +350,9 @@ vmTag = "VM"
 xsaneTag :: String
 xsaneTag = "XSANE"
 f5Tag :: String
 f5Tag = "F5VPN"
 gimpDynamicWorkspace :: Sometimes DynWorkspace
 gimpDynamicWorkspace = sometimesIO_ "gimp workspace" "gimp" tree dw
  where
@ -417,11 +425,31 @@ xsaneDynamicWorkspace =
        }
    c = "Xsane"
 f5vpnDynamicWorkspace :: Sometimes DynWorkspace
 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
        }
    c = "F5 VPN"
 allDWs' :: [Sometimes DynWorkspace]
 allDWs' =
  [ xsaneDynamicWorkspace
  , vmDynamicWorkspace
  , gimpDynamicWorkspace
  , f5vpnDynamicWorkspace
  ]
 --------------------------------------------------------------------------------
@ -436,10 +464,6 @@ myLayouts tt =
      mkToggle (single HIDE) $
        tall ||| fulltab ||| full
  where
    addTopBar
      :: (Eq a)
      => l a
      -> ModifiedLayout (Decoration NoFrillsDecoration DefaultShrinker) l a
    addTopBar = noFrillsDeco shrinkText tt
    tall =
      renamed [Replace "Tall"] $
@ -832,9 +856,8 @@ 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-<F7>" "select autorandr profile" $ Left $ toX runAutorandrMenu
+      , KeyBinding "M-<F8>" "select autorandr profile" $ Left $ toX runAutorandrMenu
-      , KeyBinding "M-<F8>" "toggle wifi" $ Left $ toX runToggleWifi
+      , KeyBinding "M-<F9>" "toggle ethernet" $ Left $ toX runToggleEthernet
      , KeyBinding "M-<F9>" "toggle network" $ Left $ toX runToggleNetworking
      , 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
--- a/assets/icons/wifi_0.xpm
+++ b/assets/icons/wifi_0.xpm
--- a/assets/icons/wifi_1.xpm
+++ b/assets/icons/wifi_1.xpm
--- a/assets/icons/wifi_2.xpm
+++ b/assets/icons/wifi_2.xpm
--- a/assets/icons/wifi_3.xpm
+++ b/assets/icons/wifi_3.xpm
--- a/assets/icons/wifi_4.xpm
+++ b/assets/icons/wifi_4.xpm
--- a/assets/icons/wifi_5.xpm
+++ b/assets/icons/wifi_5.xpm
--- a/assets/icons/wifi_6.xpm
+++ b/assets/icons/wifi_6.xpm
--- a/assets/icons/wifi_7.xpm
+++ b/assets/icons/wifi_7.xpm
--- a/assets/icons/wifi_8.xpm
+++ b/assets/icons/wifi_8.xpm
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@ -1,3 +1,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Common internal DBus functions
@ -5,17 +9,11 @@ module Data.Internal.DBus
  ( SafeClient (..)
  , SysClient (..)
  , SesClient (..)
  , NamedConnection (..)
  , NamedSesConnection
  , NamedSysConnection
  , DBusEnv (..)
  , DIO
  , HasClient (..)
  , releaseBusName
  , withDIO
  , addMatchCallback
  , addMatchCallbackSignal
  , matchSignalFull
  , matchProperty
  , matchPropertyFull
  , matchPropertyChanged
@ -41,10 +39,6 @@ module Data.Internal.DBus
  , displayMemberName
  , displayInterfaceName
  , displayWrapQuote
  , busNameT
  , interfaceNameT
  , memberNameT
  , objectPathT
  )
 where
@ -59,129 +53,48 @@ import qualified RIO.Text as T
 --------------------------------------------------------------------------------
 -- Type-safe client
 data NamedConnection c = NamedConnection
  { ncClient :: !Client
  , ncHumanName :: !(Maybe BusName)
  --, ncUniqueName :: !BusName
  , ncType :: !c
  }
 type NamedSesConnection = NamedConnection SesClient
 type NamedSysConnection = NamedConnection SysClient
 class SafeClient c where
  toClient :: c -> Client
  getDBusClient
    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-    => Maybe BusName
+    => m (Maybe c)
    -> m (Maybe (NamedConnection c))
-  disconnectDBusClient
+  disconnectDBusClient :: MonadUnliftIO m => c -> m ()
-    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  disconnectDBusClient = liftIO . disconnect . toClient
    => NamedConnection c
    -> m ()
  disconnectDBusClient c = do
    releaseBusName c
    liftIO $ disconnect $ ncClient c
  withDBusClient
    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-    => Maybe BusName
+    => (c -> m a)
    -> (NamedConnection c -> m a)
    -> m (Maybe a)
-  withDBusClient n f =
+  withDBusClient f =
-    bracket (getDBusClient n) (mapM (liftIO . disconnect . ncClient)) $ mapM f
+    bracket getDBusClient (mapM (liftIO . disconnect . toClient)) $ mapM f
  withDBusClient_
    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-    => Maybe BusName
+    => (c -> m ())
    -> (NamedConnection c -> m ())
    -> m ()
-  withDBusClient_ n = void . withDBusClient n
+  withDBusClient_ = void . withDBusClient
  fromDBusClient
    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-    => Maybe BusName
+    => (c -> a)
    -> (NamedConnection c -> a)
    -> m (Maybe a)
-  fromDBusClient n f = withDBusClient n (return . f)
+  fromDBusClient f = withDBusClient (return . f)
-data SysClient = SysClient
+newtype SysClient = SysClient Client
 instance SafeClient SysClient where
-  getDBusClient = connectToDBusWithName True SysClient
+  toClient (SysClient cl) = cl
-data SesClient = SesClient
+  getDBusClient = fmap SysClient <$> getDBusClient' True
 newtype SesClient = SesClient Client
 instance SafeClient SesClient where
-  -- TODO wet
+  toClient (SesClient cl) = cl
  getDBusClient = connectToDBusWithName False SesClient
-connectToDBusWithName
+  getDBusClient = fmap SesClient <$> getDBusClient' False
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => Bool
  -> c
  -> Maybe BusName
  -> m (Maybe (NamedConnection c))
 connectToDBusWithName sys t n = do
  clRes <- getDBusClient' sys
  case clRes of
    Nothing -> do
      logError "could not get client"
      return Nothing
    Just cl -> do
      --helloRes <- liftIO $ callHello cl
      --case helloRes of
      --  Nothing -> do
      --    logError "count not get unique name"
      --    return Nothing
      --  Just unique -> do
          n' <- maybe (return Nothing) (`requestBusName` cl) n
          return $
            Just $
              NamedConnection
                { ncClient = cl
                , ncHumanName = n'
      --          , ncUniqueName = unique
                , ncType = t
                }
 releaseBusName
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => NamedConnection c
  -> m ()
 releaseBusName NamedConnection {ncClient, ncHumanName} = do
  -- TODO this might error?
  case ncHumanName of
    Just n -> do
      liftIO $ void $ releaseName ncClient n
      logInfo $ "released bus name: " <> displayBusName n
    Nothing -> return ()
 requestBusName
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => BusName
  -> Client
  -> m (Maybe BusName)
 requestBusName n cl = do
  res <- try $ liftIO $ requestName cl n []
  case res of
    Left e -> do
      logError $ displayBytesUtf8 $ BC.pack $ clientErrorMessage e
      return Nothing
    Right r -> do
      let msg
            | r == NamePrimaryOwner = "registering name"
            | r == NameAlreadyOwner = "this process already owns name"
            | r == NameInQueue
                || r == NameExists =
                "another process owns name"
            -- this should never happen
            | otherwise = "unknown error when requesting name"
      logInfo $ msg <> ": " <> displayBusName n
      case r of
        NamePrimaryOwner -> return $ Just n
        _ -> return Nothing
 getDBusClient'
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
@ -195,28 +108,19 @@ getDBusClient' sys = do
      return Nothing
    Right c -> return $ Just c
--callHello :: Client -> IO (Maybe BusName)
+data DBusEnv env c = DBusEnv {dClient :: !c, dEnv :: !env}
 --callHello cl = do
 --  reply <- call_ cl $ methodCallBus dbusName dbusPath dbusInterface "Hello"
 --  case methodReturnBody reply of
 --    [name] | Just nameStr <- fromVariant name -> do
 --      busName <- parseBusName nameStr
 --      return $ Just busName
 --    _ -> return Nothing
 --
 data DBusEnv env c = DBusEnv {dClient :: !(NamedConnection 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 HasLogFunc (DBusEnv SimpleApp c) where
+instance SafeClient c => HasLogFunc (DBusEnv SimpleApp c) where
  logFuncL = lens dEnv (\x y -> x {dEnv = y}) . logFuncL
 withDIO
-  :: (MonadUnliftIO m, MonadReader env m)
+  :: (MonadUnliftIO m, MonadReader env m, SafeClient c)
-  => NamedConnection c
+  => c
  -> DIO env c a
  -> m a
 withDIO cl x = do
@ -224,7 +128,7 @@ withDIO cl x = do
  runRIO (DBusEnv cl env) x
 class HasClient env where
-  clientL :: SafeClient c => Lens' (env c) (NamedConnection c)
+  clientL :: SafeClient c => Lens' (env c) c
 --------------------------------------------------------------------------------
 -- Methods
@ -236,7 +140,7 @@ callMethod'
  => MethodCall
  -> m MethodBody
 callMethod' mc = do
-  cl <- ncClient <$> view clientL
+  cl <- toClient <$> view clientL
  liftIO $ bimap (T.pack . methodErrorMessage) methodReturnBody <$> call cl mc
 callMethod
@ -298,21 +202,9 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant
 type SignalCallback m = [Variant] -> m ()
 addMatchCallbackSignal
  :: ( MonadReader (env c) m
     , MonadUnliftIO m
     , SafeClient c
     , HasClient env
     )
  => MatchRule
  -> (Signal -> m ())
  -> m SignalHandler
 addMatchCallbackSignal rule cb = do
  cl <- ncClient <$> view clientL
  withRunInIO $ \run -> addMatch cl rule $ run . cb
 addMatchCallback
  :: ( MonadReader (env c) m
     , HasLogFunc (env c)
     , MonadUnliftIO m
     , SafeClient c
     , HasClient env
@ -320,7 +212,10 @@ addMatchCallback
  => MatchRule
  -> SignalCallback m
  -> m SignalHandler
-addMatchCallback rule cb = addMatchCallbackSignal rule (cb . signalBody)
+addMatchCallback rule cb = do
  cl <- toClient <$> view clientL
  withRunInIO $ \run -> do
    addMatch cl rule $ run . cb . signalBody
 matchSignal
  :: Maybe BusName
@ -389,7 +284,7 @@ callPropertyGet
  -> MemberName
  -> m [Variant]
 callPropertyGet bus path iface property = do
-  cl <- ncClient <$> view clientL
+  cl <- toClient <$> view clientL
  res <- liftIO $ getProperty cl $ methodCallBus bus path iface property
  case res of
    Left err -> do
@ -424,26 +319,26 @@ withSignalMatch _ NoMatch = return ()
 matchPropertyChanged
  :: IsVariant a
  => InterfaceName
-  -> MemberName
+  -> T.Text
  -> [Variant]
  -> SignalMatch a
-matchPropertyChanged iface property [sigIface, sigValues, _] =
+matchPropertyChanged iface property [i, body, _] =
-  let i = fromVariant sigIface :: Maybe T.Text
+  let i' = (fromVariant i :: Maybe T.Text)
-      v = fromVariant sigValues :: Maybe (M.Map T.Text Variant)
+      b = toMap body
-   in case (i, v) of
+   in case (i', b) of
-        (Just i', Just v') ->
+        (Just i'', Just b') ->
-          if i' == interfaceNameT iface
+          if i'' == T.pack (formatInterfaceName iface)
-            then
+            then maybe NoMatch Match $ fromVariant =<< M.lookup property b'
              maybe NoMatch Match $
                fromVariant =<< M.lookup (memberNameT property) v'
            else NoMatch
        _ -> Failure
  where
    toMap v = fromVariant v :: Maybe (M.Map T.Text Variant)
 matchPropertyChanged _ _ _ = Failure
 --------------------------------------------------------------------------------
 -- Object Manager
-type ObjectTree = M.Map ObjectPath (M.Map InterfaceName (M.Map T.Text Variant))
+type ObjectTree = M.Map ObjectPath (M.Map T.Text (M.Map T.Text Variant))
 omInterface :: InterfaceName
 omInterface = interfaceName_ "org.freedesktop.DBus.ObjectManager"
@ -473,11 +368,7 @@ callGetManagedObjects bus path = do
    Left err -> do
      logError $ Utf8Builder $ encodeUtf8Builder err
      return M.empty
-    Right v ->
+    Right v -> return $ fromMaybe M.empty $ fromSingletonVariant v
      return $
        fmap (M.mapKeys interfaceName_) $
          fromMaybe M.empty $
            fromSingletonVariant v
 addInterfaceChangedListener
  :: ( MonadReader (env c) m
@ -541,14 +432,14 @@ addInterfaceRemovedListener bus =
 -- Interface export/unexport
 exportPair
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
  => ObjectPath
  -> (Client -> m Interface)
-  -> NamedConnection c
+  -> c
  -> (m (), m ())
 exportPair path toIface cl = (up, down)
  where
-    cl_ = ncClient cl
+    cl_ = toClient cl
    up = do
      logInfo $ "adding interface: " <> path_
      i <- toIface cl_
@ -561,18 +452,6 @@ exportPair path toIface cl = (up, down)
 --------------------------------------------------------------------------------
 -- logging helpers
 busNameT :: BusName -> T.Text
 busNameT = T.pack . formatBusName
 objectPathT :: ObjectPath -> T.Text
 objectPathT = T.pack . formatObjectPath
 interfaceNameT :: InterfaceName -> T.Text
 interfaceNameT = T.pack . formatInterfaceName
 memberNameT :: MemberName -> T.Text
 memberNameT = T.pack . formatMemberName
 displayBusName :: BusName -> Utf8Builder
 displayBusName = displayBytesUtf8 . BC.pack . formatBusName
--- a/lib/Data/Internal/XIO.hs
+++ b/lib/Data/Internal/XIO.hs
@ -1,3 +1,12 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 --------------------------------------------------------------------------------
 -- Functions for handling dependencies
@ -100,7 +109,6 @@ import qualified DBus.Introspection as I
 import Data.Aeson hiding (Error, Result)
 import Data.Aeson.Key
 import Data.Internal.DBus
 import qualified Data.Text.IO as TI
 import Data.Yaml
 import GHC.IO.Exception (ioe_description)
 import RIO hiding (bracket, fromString)
@ -132,9 +140,9 @@ runXIO logfile x = withLogFile logfile $ \h -> hRunXIO True h x
 withLogFile :: MonadUnliftIO m => FilePath -> (Handle -> m a) -> m a
 withLogFile logfile f = do
  p <- (</> logfile) . dataDir <$> liftIO getDirectories
-  catchIO (withBinaryFile p AppendMode f) $ \e -> do
+  catchIO (withFile p AppendMode f) $ \e -> do
-    liftIO $ TI.putStrLn $ T.pack $ show e
+    liftIO $ print e
-    liftIO $ TI.putStrLn "could not open log file, falling back to stderr"
+    liftIO $ putStrLn "could not open log file, falling back to stderr"
    f stderr
 hRunXIO :: Bool -> Handle -> XIO a -> IO a
@ -288,18 +296,8 @@ type SubfeatureRoot a = Subfeature (Root a)
 data Root a
  = forall p. IORoot (p -> a) (IOTree p)
  | IORoot_ a IOTree_
-  | forall c p.
+  | forall c p. SafeClient c => DBusRoot (p -> c -> a) (DBusTree c p) (Maybe c)
-    SafeClient c =>
+  | forall c. SafeClient c => DBusRoot_ (c -> a) (DBusTree_ c) (Maybe c)
    DBusRoot
      (p -> NamedConnection c -> a)
      (DBusTree c p)
      (Maybe (NamedConnection c))
  | forall c.
    SafeClient c =>
    DBusRoot_
      (NamedConnection c -> a)
      (DBusTree_ c)
      (Maybe (NamedConnection c))
 instance Functor Root where
  fmap f (IORoot a t) = IORoot (f . a) t
@ -427,7 +425,7 @@ data XEnv = XEnv
 instance HasLogFunc XEnv where
  logFuncL = lens xLogFun (\x y -> x {xLogFun = y})
-instance HasLogFunc (DBusEnv XEnv c) where
+instance SafeClient c => HasLogFunc (DBusEnv XEnv c) where
  logFuncL = lens dEnv (\x y -> x {dEnv = y}) . logFuncL
 instance HasProcessContext XEnv where
@ -468,8 +466,7 @@ data XPFeatures = XPFeatures
  , xpfIntelBacklight :: Bool
  , xpfClevoBacklight :: Bool
  , xpfBattery :: Bool
-  , xpfEthPrefix :: Maybe Text
+  , xpfF5VPN :: Bool
  , xpfWifiPrefix :: Maybe Text
  }
 instance FromJSON XPFeatures where
@ -496,9 +493,7 @@ instance FromJSON XPFeatures where
      <*> o
      .:+ "battery"
      <*> o
-      .:? "ethPrefix"
+      .:+ "f5vpn"
      <*> o
      .:? "wifiPrefix"
 defParams :: XParams
 defParams =
@ -521,8 +516,7 @@ defXPFeatures =
    , xpfIntelBacklight = False
    , xpfClevoBacklight = False
    , xpfBattery = False
-    , xpfEthPrefix = Nothing
+    , xpfF5VPN = False
    , xpfWifiPrefix = Nothing
    }
 type XPQuery = XPFeatures -> Bool
@ -533,7 +527,7 @@ getParams = do
  maybe (return defParams) (liftIO . decodeYaml) p
  where
    decodeYaml p =
-      either (\e -> TI.putStrLn (T.pack $ show e) >> return defParams) return
+      either (\e -> print e >> return defParams) return
        =<< decodeFileEither p
 getParamFile :: MonadIO m => m (Maybe FilePath)
@ -833,16 +827,16 @@ testFont fam = maybe pass (Left . (: [])) <$> shellTest "fc-list" args msg
 -- start with "en" and wireless interfaces always start with "wl"
 readEthernet :: IODependency T.Text
-readEthernet = readInterface "get ethernet interface" (fromMaybe "en" . xpfEthPrefix)
+readEthernet = readInterface "get ethernet interface" isEthernet
 readWireless :: IODependency T.Text
-readWireless = readInterface "get wireless interface" (fromMaybe "wl" . xpfWifiPrefix)
+readWireless = readInterface "get wireless interface" isWireless
-- isWireless :: T.Text -> Bool
+isWireless :: T.Text -> Bool
-- isWireless = T.isPrefixOf "wl"
+isWireless = T.isPrefixOf "wl"
-- isEthernet :: T.Text -> Bool
+isEthernet :: T.Text -> Bool
-- isEthernet = T.isPrefixOf "en"
+isEthernet = T.isPrefixOf "en"
 listInterfaces :: MonadUnliftIO m => m [T.Text]
 listInterfaces =
@ -854,12 +848,11 @@ sysfsNet = "/sys/class/net"
 -- ASSUME there are no (non-base) packages required to make these interfaces
 -- work (all at the kernel level)
-readInterface :: T.Text -> (XPFeatures -> Text) -> IODependency T.Text
+readInterface :: T.Text -> (T.Text -> Bool) -> IODependency T.Text
 readInterface n f = IORead n [] go
  where
-    go = do
+    go = io $ do
-      p <- asks (f . xpFeatures . xParams)
+      ns <- filter f <$> listInterfaces
      ns <- filter (T.isPrefixOf p) <$> listInterfaces
      case ns of
        [] -> return $ Left [Msg LevelError "no interfaces found"]
        (x : xs) -> do
@ -895,10 +888,10 @@ introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
 introspectMethod :: MemberName
 introspectMethod = memberName_ "Introspect"
-testDBusDep_ :: SafeClient c => NamedConnection c -> DBusDependency_ c -> XIO MResult_
+testDBusDep_ :: SafeClient c => c -> DBusDependency_ c -> XIO MResult_
 testDBusDep_ c d = memoizeMVar $ testDBusDepNoCache_ c d
-testDBusDepNoCache_ :: SafeClient c => NamedConnection c -> DBusDependency_ c -> XIO Result_
+testDBusDepNoCache_ :: SafeClient c => c -> DBusDependency_ c -> XIO Result_
 testDBusDepNoCache_ cl (Bus _ bus) = do
  ret <- withDIO cl $ callMethod queryBus queryPath queryIface queryMem
  return $ case ret of
@ -1029,11 +1022,11 @@ sometimesExeArgs fn n ful sys path args =
 sometimesDBus
  :: SafeClient c
-  => Maybe (NamedConnection c)
+  => Maybe c
  -> T.Text
  -> T.Text
  -> Tree_ (DBusDependency_ c)
-  -> (NamedConnection c -> a)
+  -> (c -> a)
  -> Sometimes a
 sometimesDBus c fn n t x = sometimes1 fn n $ DBusRoot_ x t c
@ -1047,7 +1040,7 @@ sometimesEndpoint
  -> ObjectPath
  -> InterfaceName
  -> MemberName
-  -> Maybe (NamedConnection c)
+  -> Maybe c
  -> Sometimes (m ())
 sometimesEndpoint fn name ful busname path iface mem cl =
  sometimesDBus cl fn name deps cmd
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Dmenu (Rofi) Commands
@ -146,7 +148,7 @@ runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"]
 runWinMenu :: MonadUnliftIO m => Sometimes (m ())
 runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]
-runNetMenu :: MonadUnliftIO m => Maybe NamedSysConnection -> Sometimes (m ())
+runNetMenu :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
 runNetMenu cl =
  Sometimes
    "network control menu"
@ -171,7 +173,7 @@ runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
 --------------------------------------------------------------------------------
 -- Password manager
-runBwMenu :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runBwMenu :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd
  where
    cmd _ =
@ -208,7 +210,7 @@ runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
 -- Shortcut menu
 runShowKeys
-  :: (MonadReader env m, MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => Always ([((KeyMask, KeySym), NamedAction)] -> m ())
 runShowKeys =
  Always "keyboard menu" $
@ -223,7 +225,7 @@ runShowKeys =
          defNoteError {body = Just $ Text "could not display keymap"}
 showKeysDMenu
-  :: (MonadReader env m, MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> m ())
 showKeysDMenu =
  Subfeature
@ -232,7 +234,7 @@ showKeysDMenu =
    }
 showKeys
-  :: (MonadReader env m, MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => [((KeyMask, KeySym), NamedAction)]
  -> m ()
 showKeys kbs = do
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- General commands
@ -19,8 +21,7 @@ module XMonad.Internal.Command.Desktop
  , runVolumeUp
  , runVolumeMute
  , runToggleBluetooth
-  , runToggleNetworking
+  , runToggleEthernet
  , runToggleWifi
  , runRestart
  , runRecompile
  , runAreaCapture
@ -59,13 +60,13 @@ import XMonad.Operations
 -- My Executables
 myTerm :: FilePath
-myTerm = "alacritty"
+myTerm = "urxvt"
 myCalc :: FilePath
 myCalc = "bc"
 myBrowser :: FilePath
-myBrowser = "firefox"
+myBrowser = "brave"
 myEditor :: FilePath
 myEditor = "emacsclient"
@ -93,7 +94,8 @@ myNotificationCtrl = "dunstctl"
 myTermPkgs :: [Fulfillment]
 myTermPkgs =
-  [ Package Official "alacritty"
+  [ Package Official "rxvt-unicode"
  , Package Official "urxvt-perls"
  ]
 myEditorPkgs :: [Fulfillment]
@ -108,9 +110,6 @@ bluetoothPkgs = [Package Official "bluez-utils"]
 networkManagerPkgs :: [Fulfillment]
 networkManagerPkgs = [Package Official "networkmanager"]
 nmcli :: IODependency_
 nmcli = sysExe networkManagerPkgs "nmcli"
 --------------------------------------------------------------------------------
 -- Misc constants
@ -121,7 +120,7 @@ volumeChangeSound = "smb_fireball.wav"
 -- Some nice apps
 runTerm :: MonadUnliftIO m => Sometimes (m ())
-runTerm = sometimesExe "terminal" "alacritty" myTermPkgs True myTerm
+runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm
 runTMux :: MonadUnliftIO m => Sometimes (m ())
 runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
@ -209,7 +208,7 @@ runStopPlay = runMultimediaIfInstalled "stop playback" "stop"
 -- Volume Commands
 soundDir :: FilePath
-soundDir = "assets" </> "sound"
+soundDir = "sound"
 playSound :: MonadIO m => FilePath -> m ()
 playSound file = do
@ -249,7 +248,7 @@ runNotificationCmd
  :: MonadUnliftIO m
  => T.Text
  -> T.Text
-  -> Maybe NamedSesConnection
+  -> Maybe SesClient
  -> Sometimes (m ())
 runNotificationCmd n arg cl =
  sometimesDBus cl (T.unwords [n, "control"]) "dunstctl" tree cmd
@ -261,37 +260,37 @@ runNotificationCmd n arg cl =
          Method_ $
            memberName_ "NotificationAction"
-runNotificationClose :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runNotificationClose :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationClose = runNotificationCmd "close notification" "close"
-runNotificationCloseAll :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runNotificationCloseAll :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationCloseAll =
  runNotificationCmd "close all notifications" "close-all"
-runNotificationHistory :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runNotificationHistory :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationHistory =
  runNotificationCmd "see notification history" "history-pop"
-runNotificationContext :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runNotificationContext :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationContext =
  runNotificationCmd "open notification context" "context"
 --------------------------------------------------------------------------------
 -- System commands
-- needed to lookup/prompt for passwords/keys for wifi connections and some VPNs
+-- this is required for some vpn's to work properly with network-manager
-runNetAppDaemon :: Maybe NamedSysConnection -> Sometimes (XIO (P.Process () () ()))
+runNetAppDaemon :: Maybe SysClient -> Sometimes (XIO (P.Process () () ()))
 runNetAppDaemon cl =
  Sometimes
    "network applet"
-    (\x -> xpfVPN x || xpfWireless x)
+    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 :: MonadUnliftIO m => Maybe NamedSysConnection -> Sometimes (m ())
+runToggleBluetooth :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
 runToggleBluetooth cl =
  Sometimes
    "bluetooth toggle"
@ -308,35 +307,27 @@ runToggleBluetooth cl =
          #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "bluetooth powered $a"}
-runToggleNetworking :: MonadUnliftIO m => Sometimes (m ())
+runToggleEthernet :: MonadUnliftIO m => Sometimes (m ())
-runToggleNetworking =
+runToggleEthernet =
  Sometimes
-    "network toggle"
+    "ethernet toggle"
-    (\x -> xpfEthernet x || xpfWireless x)
+    xpfEthernet
    [Subfeature root "nmcli"]
  where
-    root = IORoot_ cmd $ Only_ nmcli
+    root =
-    cmd =
+      IORoot cmd $
        And1 (Only readEthernet) $
          Only_ $
            sysExe networkManagerPkgs "nmcli"
    -- TODO make this less noisy
    cmd iface =
      S.spawn $
-        fmtCmd "nmcli" ["networking"]
+        fmtCmd "nmcli" ["-g", "GENERAL.STATE", "device", "show", iface]
-          #!| "grep -q enabled"
+          #!| "grep -q disconnected"
-          #!&& "a=off"
+          #!&& "a=connect"
-          #!|| "a=on"
+          #!|| "a=disconnect"
-          #!>> fmtCmd "nmcli" ["networking", "$a"]
+          #!>> fmtCmd "nmcli" ["device", "$a", iface]
-          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "networking switched $a"}
+          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "ethernet \"$a\"ed"}
 runToggleWifi :: MonadUnliftIO m => Sometimes (m ())
 runToggleWifi = Sometimes "wifi toggle" xpfWireless [Subfeature root "nmcli"]
  where
    root = IORoot_ cmd $ Only_ nmcli
    cmd =
      S.spawn $
        fmtCmd "nmcli" ["radio", "wifi"]
          #!| "grep -q enabled"
          #!&& "a=off"
          #!|| "a=on"
          #!>> fmtCmd "nmcli" ["radio", "wifi", "$a"]
          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "wifi switched $a"}
 --------------------------------------------------------------------------------
 -- Configuration commands
@ -377,7 +368,7 @@ runFlameshot
  :: MonadUnliftIO m
  => T.Text
  -> T.Text
-  -> Maybe NamedSesConnection
+  -> Maybe SesClient
  -> Sometimes (m ())
 runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd
  where
@ -389,15 +380,15 @@ 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 :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runAreaCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runAreaCapture = runFlameshot "screen area capture" "gui"
 -- myWindowCap = "screencap -w" --external script
-runDesktopCapture :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runDesktopCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runDesktopCapture = runFlameshot "fullscreen capture" "full"
-runScreenCapture :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runScreenCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runScreenCapture = runFlameshot "screen capture" "screen"
 runCaptureBrowser :: MonadUnliftIO m => Sometimes (m ())
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Commands for controlling power
@ -89,8 +91,7 @@ runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
      And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock") $
        Only_ $
          IOSometimes_ runScreenLock
-    cmd = P.proc "xss-lock" args (P.startProcess . P.setCreateGroup True)
+    cmd = P.proc "xss-lock" ["--ignore-sleep", "screenlock"] (P.startProcess . P.setCreateGroup True)
    args = ["--ignore-sleep", "--", "screenlock", "true"]
 --------------------------------------------------------------------------------
 -- Confirmation prompts
@ -179,20 +180,17 @@ data PowerMaybeAction
  | Reboot
  deriving (Eq)
-fromPMA :: PowerMaybeAction -> Int
+instance Enum PowerMaybeAction where
-fromPMA a = case a of
+  toEnum 0 = Poweroff
-  Poweroff -> 0
+  toEnum 1 = Shutdown
-  Shutdown -> 1
+  toEnum 2 = Hibernate
-  Hibernate -> 2
+  toEnum 3 = Reboot
-  Reboot -> 3
+  toEnum _ = errorWithoutStackTrace "Main.Enum.PowerMaybeAction.toEnum: bad argument"
-toPMA :: Int -> Maybe PowerMaybeAction
+  fromEnum Poweroff = 0
-toPMA x = case x of
+  fromEnum Shutdown = 1
-  0 -> Just Poweroff
+  fromEnum Hibernate = 2
-  1 -> Just Shutdown
+  fromEnum Reboot = 3
  2 -> Just Hibernate
  3 -> Just Reboot
  _ -> Nothing
 data PowerPrompt = PowerPrompt
@ -224,11 +222,9 @@ powerPrompt lock fb = mkXPrompt PowerPrompt theme comp executeMaybeAction
            , (xK_Return, quit)
            , (xK_Escape, quit)
            ]
-    sendMaybeAction a = setInput (show $ fromPMA a) >> setSuccess True >> setDone True
+    sendMaybeAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
-    executeMaybeAction a = case toPMA =<< readMaybe a of
+    executeMaybeAction a = case toEnum $ read a of
-      Just Poweroff -> liftIO runPowerOff
+      Poweroff -> liftIO runPowerOff
-      Just Shutdown -> lock >> liftIO runSuspend
+      Shutdown -> lock >> liftIO runSuspend
-      Just Hibernate -> lock >> liftIO runHibernate
+      Hibernate -> lock >> liftIO runHibernate
-      Just Reboot -> liftIO runReboot
+      Reboot -> liftIO runReboot
      -- TODO log an error here since this should never happen
      Nothing -> skip
--- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
+++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
@ -1,3 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Concurrent module to handle events from acpid
@ -30,18 +33,15 @@ data ACPIEvent
  | LidClose
  deriving (Eq)
-fromACPIEvent :: ACPIEvent -> Int
+instance Enum ACPIEvent where
-fromACPIEvent x = case x of
+  toEnum 0 = Power
-  Power -> 0
+  toEnum 1 = Sleep
-  Sleep -> 1
+  toEnum 2 = LidClose
-  LidClose -> 2
+  toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument"
-toACPIEvent :: Int -> Maybe ACPIEvent
+  fromEnum Power = 0
-toACPIEvent x = case x of
+  fromEnum Sleep = 1
-  0 -> Just Power
+  fromEnum LidClose = 2
  1 -> Just Sleep
  2 -> Just LidClose
  _ -> Nothing
 --------------------------------------------------------------------------------
 -- Internal functions
@ -64,7 +64,7 @@ parseLine line =
 -- | Send an ACPIEvent to the X server as a ClientMessage
 sendACPIEvent :: ACPIEvent -> IO ()
-sendACPIEvent = sendXMsg ACPI . show . fromACPIEvent
+sendACPIEvent = sendXMsg ACPI . show . fromEnum
 isDischarging :: IO (Maybe Bool)
 isDischarging = do
@ -91,7 +91,7 @@ socketDep = Only_ $ pathR acpiPath [Package Official "acpid"]
 -- Xmonad's event hook)
 handleACPI :: FontBuilder -> X () -> String -> X ()
 handleACPI fb lock tag = do
-  let acpiTag = toACPIEvent =<< readMaybe tag :: Maybe ACPIEvent
+  let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
  forM_ acpiTag $ \case
    Power -> powerPrompt lock fb
    Sleep -> suspendPrompt fb
--- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs
+++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
@ -28,7 +28,6 @@ import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Display
 import Graphics.X11.Xlib.Event
 import Graphics.X11.Xlib.Extras
 import RIO
 import XMonad.Internal.IO
 --------------------------------------------------------------------------------
@ -43,18 +42,14 @@ data XMsgType
  | Unknown
  deriving (Eq, Show)
-fromXMsgType :: XMsgType -> Int
+instance Enum XMsgType where
-fromXMsgType x = case x of
+  toEnum 0 = ACPI
-  ACPI -> 0
+  toEnum 1 = Workspace
-  Workspace -> 1
+  toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument"
  Unknown -> 2
-toXMsgType :: Int -> Maybe XMsgType
+  fromEnum ACPI = 0
-toXMsgType x = case x of
+  fromEnum Workspace = 1
-  0 -> Just ACPI
+  fromEnum Unknown = 2
  1 -> Just Workspace
  2 -> Just Unknown
  _ -> Nothing
 --------------------------------------------------------------------------------
 -- Exported API
@ -63,9 +58,9 @@ toXMsgType x = case x of
 -- type and payload
 splitXMsg :: (Integral a) => [a] -> (XMsgType, String)
 splitXMsg [] = (Unknown, "")
-splitXMsg (x : xs) = (fromMaybe Unknown xtype, tag)
+splitXMsg (x : xs) = (xtype, tag)
  where
-    xtype = toXMsgType $ fromIntegral x
+    xtype = toEnum $ fromIntegral x
    tag = chr . fromIntegral <$> takeWhile (/= 0) xs
 -- | Emit a ClientMessage event to the X server with the given type and payloud
@ -91,5 +86,5 @@ sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
    setClientMessageEvent' e root bITMAP 8 (x : t)
    sendEvent dpy root False substructureNotifyMask e
  where
-    x = fromIntegral $ fromXMsgType xtype
+    x = fromIntegral $ fromEnum xtype
    t = fmap (fromIntegral . fromEnum) tag
--- 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
--- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs
+++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
@ -1,3 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 --------------------------------------------------------------------------------
 -- VirtualBox-specific functions
@ -33,7 +36,7 @@ vmInstanceConfig vmName = do
 vmDirectory :: IO (Either String String)
 vmDirectory = do
  p <- vmConfig
-  s <- tryIO $ readFileUtf8 p
+  s <- tryIO $ readFile p
  return $ case s of
    (Left _) -> Left "could not read VirtualBox config file"
    (Right x) ->
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@ -1,3 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- DBus module for Clevo Keyboard control
@ -117,7 +120,7 @@ clevoKeyboardSignalDep =
 exportClevoKeyboard
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> Sometimes (m (), m ())
 exportClevoKeyboard =
  brightnessExporter
@ -128,7 +131,7 @@ exportClevoKeyboard =
 clevoKeyboardControls
  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> BrightnessControls m
 clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
@ -139,6 +142,7 @@ callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
 matchSignalCK
  :: ( SafeClient c
     , HasLogFunc (env c)
     , HasClient env
     , MonadReader (env c) m
     , MonadUnliftIO m
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@ -1,3 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
 --------------------------------------------------------------------------------
 -- DBus module for DBus brightness controls
@ -53,7 +57,7 @@ brightnessControls
  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
  => XPQuery
  -> BrightnessConfig m a b
-  -> Maybe NamedSesConnection
+  -> Maybe SesClient
  -> BrightnessControls m
 brightnessControls q bc cl =
  BrightnessControls
@ -76,14 +80,15 @@ callGetBrightness
  -> m (Maybe n)
 callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} =
  either (const Nothing) bodyGetBrightness
-    <$> callMethod xmonadSesBusName p i memGet
+    <$> callMethod xmonadBusName p i memGet
-signalDep :: BrightnessConfig m a b -> DBusDependency_ c
+signalDep :: BrightnessConfig m a b -> DBusDependency_ SesClient
 signalDep BrightnessConfig {bcPath = p, bcInterface = i} =
-  Endpoint [] xmonadSesBusName p i $ Signal_ memCur
+  Endpoint [] xmonadBusName p i $ Signal_ memCur
 matchSignal
  :: ( HasClient env
     , HasLogFunc (env c)
     , MonadReader (env c) m
     , MonadUnliftIO m
     , SafeClient c
@ -112,18 +117,18 @@ brightnessExporter
  -> [Fulfillment]
  -> [IODependency_]
  -> BrightnessConfig m a b
-  -> Maybe NamedSesConnection
+  -> Maybe SesClient
  -> 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_ (exportBrightnessControlsInner bc) tree cl
-    tree = listToAnds (Bus ful xmonadSesBusName) $ fmap DBusIO deps
+    tree = listToAnds (Bus ful xmonadBusName) $ fmap DBusIO deps
 exportBrightnessControlsInner
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, RealFrac b)
  => BrightnessConfig m a b
-  -> NamedSesConnection
+  -> SesClient
  -> (m (), m ())
 exportBrightnessControlsInner bc = cmd
  where
@ -172,7 +177,7 @@ emitBrightness BrightnessConfig {bcPath = p, bcInterface = i} client cur =
 callBacklight
  :: (MonadReader env m, HasClient (DBusEnv env), MonadUnliftIO m)
  => XPQuery
-  -> Maybe NamedSesConnection
+  -> Maybe SesClient
  -> BrightnessConfig m a b
  -> T.Text
  -> MemberName
@ -180,8 +185,8 @@ callBacklight
 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 [] xmonadSesBusName p i $ Method_ m) cl
+    root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
-    cmd c = void $ withDIO c $ callMethod xmonadSesBusName p i m
+    cmd c = void $ withDIO c $ callMethod xmonadBusName p i m
 bodyGetBrightness :: Num a => [Variant] -> Maybe a
 bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@ -1,3 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- DBus module for Intel Backlight control
@ -103,7 +106,7 @@ intelBacklightSignalDep =
 exportIntelBacklight
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> Sometimes (m (), m ())
 exportIntelBacklight =
  brightnessExporter
@ -114,7 +117,7 @@ exportIntelBacklight =
 intelBacklightControls
  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> BrightnessControls m
 intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig
@ -125,6 +128,7 @@ callGetBrightnessIB = callGetBrightness intelBacklightConfig
 matchSignalIB
  :: ( SafeClient c
     , HasLogFunc (env c)
     , HasClient env
     , MonadReader (env c) m
     , MonadUnliftIO m
--- a/lib/XMonad/Internal/DBus/Common.hs
+++ b/lib/XMonad/Internal/DBus/Common.hs
@ -2,8 +2,7 @@
 -- High-level interface for managing XMonad's DBus
 module XMonad.Internal.DBus.Common
-  ( xmonadSesBusName
+  ( xmonadBusName
  , xmonadSysBusName
  , btBus
  , notifyBus
  , notifyPath
@ -13,11 +12,8 @@ where
 import DBus
-xmonadSesBusName :: BusName
+xmonadBusName :: BusName
-xmonadSesBusName = busName_ "org.xmonad.session"
+xmonadBusName = busName_ "org.xmonad"
 xmonadSysBusName :: BusName
 xmonadSysBusName = busName_ "org.xmonad.system"
 btBus :: BusName
 btBus = busName_ "org.bluez"
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@ -1,3 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 --------------------------------------------------------------------------------
 -- High-level interface for managing XMonad's DBus
@ -10,8 +13,9 @@ module XMonad.Internal.DBus.Control
  , withDBus
  , withDBus_
  , connectDBus
  , connectDBusX
  , disconnectDBus
-  -- , disconnectDBusX
+  , disconnectDBusX
  , getDBusClient
  , withDBusClient
  , withDBusClient_
@ -25,6 +29,7 @@ import DBus.Client
 import Data.Internal.DBus
 import Data.Internal.XIO
 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
@ -32,8 +37,8 @@ import XMonad.Internal.DBus.Screensaver
 -- | Current connections to the DBus (session and system buses)
 data DBusState = DBusState
-  { dbSesClient :: Maybe NamedSesConnection
+  { dbSesClient :: Maybe SesClient
-  , dbSysClient :: Maybe NamedSysConnection
+  , dbSysClient :: Maybe SysClient
  }
 withDBusX_
@ -45,79 +50,59 @@ withDBusX_ = void . withDBusX
 withDBusX
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => (DBusState -> m a)
-  -> m a
+  -> m (Maybe a)
-withDBusX = withDBus (Just xmonadSesBusName) Nothing
+withDBusX f = withDBus $ \db -> do
  forM (dbSesClient db) $ \ses -> do
    bracket_ (requestXMonadName ses) (releaseXMonadName ses) $ f db
 withDBus_
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe BusName
+  => (DBusState -> m a)
  -> Maybe BusName
  -> (DBusState -> m a)
  -> m ()
-withDBus_ sesname sysname = void . withDBus sesname sysname
+withDBus_ = void . withDBus
 withDBus
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe BusName
+  => (DBusState -> m a)
  -> Maybe BusName
  -> (DBusState -> m a)
  -> m a
-withDBus sesname sysname = bracket (connectDBus sesname sysname) disconnectDBus
+withDBus = bracket connectDBus disconnectDBus
 -- | Connect to the DBus
 connectDBus
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe BusName
+  => m DBusState
-  -> Maybe BusName
+connectDBus = do
-  -> m DBusState
+  ses <- getDBusClient
-connectDBus sesname sysname = do
+  sys <- getDBusClient
  ses <- getDBusClient sesname
  sys <- getDBusClient sysname
  return DBusState {dbSesClient = ses, dbSysClient = sys}
 -- | Disconnect from the DBus
-disconnectDBus
+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
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => m DBusState
 connectDBusX = do
  db <- connectDBus
  forM_ (dbSesClient db) requestXMonadName
  return db
 -- | Disconnect from DBus and release the XMonad name
 disconnectDBusX
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => DBusState
  -> m ()
-disconnectDBus db = disc dbSesClient >> disc dbSysClient
+disconnectDBusX db = do
-  where
+  forM_ (dbSesClient db) releaseXMonadName
-    disc
+  disconnectDBus db
      :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
      => (DBusState -> Maybe (NamedConnection c))
      -> m ()
    disc f = maybe (return ()) disconnectDBusClient $ f db
 -- -- | Connect to the DBus and request the XMonad name
 -- connectDBusX
 --   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
 --   => m DBusState
 -- connectDBusX = do
 --   db <- connectDBus
 --   requestXMonadName2 db
 --   return db
 -- -- | Disconnect from DBus and release the XMonad name
 -- disconnectDBusX
 --   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
 --   => DBusState
 --   -> m ()
 -- disconnectDBusX db = do
 --   forM_ (dbSesClient db) releaseBusName
 --   forM_ (dbSysClient db) releaseBusName
 --   disconnectDBus db
 -- requestXMonadName2
 --   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
 --   => DBusState
 --   -> m ()
 -- requestXMonadName2 db = do
 --   forM_ (dbSesClient db) requestXMonadName
 --   forM_ (dbSysClient db) requestXMonadName
 withDBusInterfaces
  :: DBusState
-  -> [Maybe NamedSesConnection -> Sometimes (XIO (), XIO ())]
+  -> [Maybe SesClient -> Sometimes (XIO (), XIO ())]
  -> ([XIO ()] -> XIO a)
  -> XIO a
 withDBusInterfaces db interfaces = bracket up sequence
@ -130,59 +115,35 @@ withDBusInterfaces db interfaces = bracket up sequence
 -- | All exporter features to be assigned to the DBus
 dbusExporters
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => [Maybe NamedSesConnection -> Sometimes (m (), m ())]
+  => [Maybe SesClient -> Sometimes (m (), m ())]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
-- releaseXMonadName
+releaseXMonadName
--   :: (SafeClient c, MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
--   => c
+  => SesClient
--   -> m ()
+  -> m ()
-- releaseXMonadName cl = do
+releaseXMonadName ses = do
--   -- TODO this might error?
+  -- TODO this might error?
--   liftIO $ void $ releaseName (toClient cl) xmonadBusName
+  liftIO $ void $ releaseName (toClient ses) xmonadBusName
--   logInfo "released xmonad name"
+  logInfo "released xmonad name"
-- releaseBusName
+requestXMonadName
--   :: (SafeClient c, MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
--   => BusName
+  => SesClient
--   -> c
+  -> m ()
--   -> m ()
+requestXMonadName ses = do
-- releaseBusName n cl = do
+  res <- liftIO $ requestName (toClient ses) xmonadBusName []
--   -- TODO this might error?
+  let msg
--   liftIO $ void $ releaseName (toClient cl) n
+        | res == NamePrimaryOwner = "registering name"
--   logInfo $ "released bus name: " <> displayBusName n
+        | res == NameAlreadyOwner = "this process already owns name"
-
+        | res == NameInQueue
-- requestBusName
+            || res == NameExists =
--   :: (SafeClient c, MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+            "another process owns name"
--   => BusName
+        | otherwise = "unknown error when requesting name"
--   -> c
+  logInfo $ msg <> ": " <> xn
--   -> m ()
+  where
-- requestBusName n cl = do
+    xn =
--   res <- try $ liftIO $ requestName (toClient cl) n []
+      Utf8Builder $
--   case res of
+        encodeUtf8Builder $
--     Left e -> logError $ displayBytesUtf8 $ BC.pack $ clientErrorMessage e
+          T.pack $
--     Right r -> do
+            formatBusName xmonadBusName
 --       let msg
 --             | r == NamePrimaryOwner = "registering name"
 --             | r == NameAlreadyOwner = "this process already owns name"
 --             | r == NameInQueue
 --                 || r == NameExists =
 --                 "another process owns name"
 --             -- this should never happen
 --             | otherwise = "unknown error when requesting name"
 --       logInfo $ msg <> ": " <> displayBusName n
 -- requestXMonadName
 --   :: (SafeClient c, MonadReader env m, HasLogFunc env, MonadUnliftIO m)
 --   => c
 --   -> m ()
 -- requestXMonadName cl = do
 --   res <- liftIO $ requestName (toClient cl) xmonadBusName []
 --   let msg
 --         | res == NamePrimaryOwner = "registering name"
 --         | res == NameAlreadyOwner = "this process already owns name"
 --         | res == NameInQueue
 --             || res == NameExists =
 --             "another process owns name"
 --         | otherwise = "unknown error when requesting name"
 --   logInfo $ msg <> ": " <> displayBusName xmonadBusName
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@ -1,3 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Module for monitoring removable drive events
 --
@ -80,10 +83,11 @@ playSoundMaybe p b = when b $ io $ playSound p
 -- enable the udisks2 service at boot; however this is not default behavior.
 listenDevices
  :: ( HasClient (DBusEnv env)
     , HasLogFunc (DBusEnv env SysClient)
     , MonadReader env m
     , MonadUnliftIO m
     )
-  => NamedSysConnection
+  => SysClient
  -> m ()
 listenDevices cl = do
  addMatch' memAdded driveInsertedSound addedHasDrive
@ -95,10 +99,11 @@ listenDevices cl = do
 runRemovableMon
  :: ( HasClient (DBusEnv env)
     , HasLogFunc (DBusEnv env SysClient)
     , MonadReader env m
     , MonadUnliftIO m
     )
-  => Maybe NamedSysConnection
+  => Maybe SysClient
  -> Sometimes (m ())
 runRemovableMon cl =
  sometimesDBus cl "removeable device monitor" "dbus monitor" deps listenDevices
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@ -1,3 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- DBus module for X11 screensave/DPMS control
@ -93,7 +96,7 @@ bodyGetCurrentState _ = Nothing
 exportScreensaver
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> Sometimes (m (), m ())
 exportScreensaver ses =
  sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) cmd
@ -119,19 +122,19 @@ exportScreensaver ses =
                }
            ]
        }
-    bus = Bus [] xmonadSesBusName
+    bus = Bus [] xmonadBusName
    ssx = DBusIO $ sysExe [Package Official "xorg-xset"] ssExecutable
 callToggle
  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> Sometimes (m ())
 callToggle =
  sometimesEndpoint
    "screensaver toggle"
    "dbus switch"
    []
-    xmonadSesBusName
+    xmonadBusName
    ssPath
    interface
    memToggle
@ -140,11 +143,12 @@ callQuery
  :: (HasClient env, MonadReader (env SesClient) m, MonadUnliftIO m)
  => m (Maybe SSState)
 callQuery = do
-  reply <- callMethod xmonadSesBusName ssPath interface memQuery
+  reply <- callMethod xmonadBusName ssPath interface memQuery
  return $ either (const Nothing) bodyGetCurrentState reply
 matchSignal
-  :: ( HasClient env
+  :: ( HasLogFunc (env SesClient)
     , HasClient env
     , MonadReader (env SesClient) m
     , MonadUnliftIO m
     )
@ -157,4 +161,4 @@ matchSignal cb =
      (cb . bodyGetCurrentState)
 ssSignalDep :: DBusDependency_ SesClient
-ssSignalDep = Endpoint [] xmonadSesBusName ssPath interface $ Signal_ memState
+ssSignalDep = Endpoint [] xmonadBusName ssPath interface $ Signal_ memState
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE ViewPatterns #-}
 --------------------------------------------------------------------------------
 -- Random IO-ish functions used throughtout xmonad
 --
@ -39,7 +41,7 @@ import System.Process
 -- read
 readInt :: MonadIO m => (Read a, Integral a) => FilePath -> m a
-readInt = fmap (fromMaybe 0 . readMaybe . takeWhile isDigit . T.unpack) . readFileUtf8
+readInt = fmap (read . takeWhile isDigit . T.unpack) . readFileUtf8
 readBool :: MonadIO m => FilePath -> m Bool
 readBool = fmap (== (1 :: Int)) . readInt
@ -47,7 +49,7 @@ readBool = fmap (== (1 :: Int)) . readInt
 --------------------------------------------------------------------------------
 -- write
-writeInt :: (MonadIO m, Show a) => FilePath -> a -> m ()
+writeInt :: MonadIO m => (Show a, Integral a) => FilePath -> a -> m ()
 writeInt f = writeFileUtf8 f . T.pack . show
 writeBool :: MonadIO m => FilePath -> Bool -> m ()
@ -60,7 +62,7 @@ writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
 -- 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, RealFrac c) => (a, a) -> b -> c
+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)
--- a/lib/XMonad/Internal/Notify.hs
+++ b/lib/XMonad/Internal/Notify.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Functions for formatting and sending notifications
 --
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- Functions for formatting and spawning shell commands
 module XMonad.Internal.Shell
@ -83,7 +85,10 @@ spawn :: MonadIO m => T.Text -> m ()
 spawn = X.spawn . T.unpack
 -- | Run 'XMonad.Run.Utils.spawnPipe' with 'Text' input.
-spawnPipe :: MonadUnliftIO m => T.Text -> m Handle
+spawnPipe
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => T.Text
  -> m Handle
 spawnPipe = liftIO . XR.spawnPipe . T.unpack
 -- spawnPipeRW
--- a/lib/XMonad/Internal/Theme.hs
+++ b/lib/XMonad/Internal/Theme.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Theme for XMonad and Xmobar
@ -31,7 +33,6 @@ where
 import Data.Colour
 import Data.Colour.SRGB
 import RIO
 import qualified RIO.Text as T
 import qualified XMonad.Layout.Decoration as D
 import qualified XMonad.Prompt as P
--- a/lib/Xmobar/Plugins/ActiveConnection.hs
+++ b/lib/Xmobar/Plugins/ActiveConnection.hs
@ -1,155 +0,0 @@
 --------------------------------------------------------------------------------
 -- NetworkManager Connection plugin
 --
 -- Show active connections of varying types.
 --
 -- This plugin exclusively monitors the */ActiveConnection/* paths in the
 -- NetworkManager DBus path for state changes. It does not pin these to any
 -- particular interface but instead looks at all connections equally and filters
 -- based on their Type (ethernet, wifi, VPN, etc). For many use cases this will
 -- track well enough with either one or a collection of similar interfaces (ie
 -- all ethernet or all wifi).
 module Xmobar.Plugins.ActiveConnection
  ( ActiveConnection (..)
  , devDep
  , connAlias
  )
 where
 import DBus
 import Data.Internal.DBus
 import Data.Internal.XIO
 import RIO
 import qualified RIO.Map as M
 import qualified RIO.NonEmpty as NE
 import qualified RIO.Text as T
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
 import Xmobar
 import Xmobar.Plugins.Common
 newtype ActiveConnection
  = ActiveConnection (NE.NonEmpty T.Text, T.Text, Colors)
  deriving (Read, Show)
 connAlias :: NE.NonEmpty T.Text -> T.Text
 connAlias = T.intercalate "_" . NE.toList
 instance Exec ActiveConnection where
  alias (ActiveConnection (contypes, _, _)) = T.unpack $ connAlias contypes
  start (ActiveConnection (contypes, text, colors)) cb =
    withDBusClientConnection cb Nothing (Just "ethernet.log") $ \c -> do
      let dpy cb' = displayMaybe cb' formatter . Just =<< readState
      i <- withDIO c $ initialState contypes
      s <- newMVar i
      let mapEnv c' = mapRIO (PluginEnv c' s dpy cb)
      mapEnv c $ addListener mapEnv >> pluginDisplay
    where
      formatter names = return $ case names of
        [] -> colorText colors False text
        xs -> T.unwords [colorText colors True text, T.intercalate "|" xs]
      addListener mapEnv = do
        res <- matchSignalFull nmBus Nothing (Just nmActiveInterface) (Just stateChanged)
        case res of
          Nothing -> logError "could not start listener"
          Just rule ->
            -- Start a new connection and RIO process since the parent thread
            -- will have died before these callbacks fire, therefore the logging
            -- file descriptor will be closed. This makes a new one
            -- TODO can I recycle the client?
            void $
              addMatchCallbackSignal rule $ \sig ->
                withDBusClientConnection cb Nothing (Just "ethernet-cb.log") $ \c' ->
                  mapEnv c' $
                    testActiveType contypes sig
 nmBus :: BusName
 nmBus = "org.freedesktop.NetworkManager"
 nmPath :: ObjectPath
 nmPath = "/org/freedesktop/NetworkManager"
 nmInterface :: InterfaceName
 nmInterface = "org.freedesktop.NetworkManager"
 nmObjectTreePath :: ObjectPath
 nmObjectTreePath = "/org/freedesktop"
 nmActiveInterface :: InterfaceName
 nmActiveInterface = "org.freedesktop.NetworkManager.Connection.Active"
 stateChanged :: MemberName
 stateChanged = "StateChanged"
 -- semi-random method to test to ensure that NetworkManager is up and on DBus
 devDep :: DBusDependency_ SysClient
 devDep =
  Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
    Method_ "GetDeviceByIpIface"
 type EthIO = PluginIO EthState SysClient
 type EthState = M.Map ObjectPath T.Text
 getConnectionProp :: MemberName -> ObjectPath -> EthIO [Variant]
 getConnectionProp prop path = callPropertyGet nmBus path nmActiveInterface prop
 getConnectionId :: ObjectPath -> EthIO (Maybe T.Text)
 getConnectionId = fmap fromSingletonVariant . getConnectionProp "Id"
 getConnectionType :: ObjectPath -> EthIO (Maybe T.Text)
 getConnectionType = fmap fromSingletonVariant . getConnectionProp "Type"
 updateConnected :: NE.NonEmpty T.Text -> ObjectPath -> EthIO ()
 updateConnected contypes path = do
  typeRes <- getConnectionType path
  logMaybe "type" getId typeRes
  where
    path' = displayBytesUtf8 $ T.encodeUtf8 $ T.pack $ formatObjectPath path
    logMaybe what = maybe (logError ("could not get " <> what <> " for " <> path'))
    getId contype = do
      when (contype `elem` contypes) $ do
        idRes <- getConnectionId path
        logMaybe "ID" insertId idRes
    insertId i = do
      s <- asks plugState
      modifyMVar_ s $ return . M.insert path i
 updateDisconnected :: ObjectPath -> EthIO ()
 updateDisconnected path = do
  s <- asks plugState
  modifyMVar_ s $ return . M.delete path
 testActiveType :: NE.NonEmpty T.Text -> Signal -> EthIO ()
 testActiveType contypes sig = do
  case signalBody sig of
    [state, _] -> case fromVariant state of
      Just (2 :: Word32) -> updateConnected contypes path >> pluginDisplay
      Just 4 -> updateDisconnected path >> pluginDisplay
      _ -> return ()
    _ -> return ()
  where
    path = signalPath sig
 initialState
  :: ( SafeClient c
     , MonadUnliftIO m
     , MonadReader (env c) m
     , HasClient env
     , HasLogFunc (env c)
     )
  => NE.NonEmpty T.Text
  -> m EthState
 initialState contypes =
  M.mapMaybe go <$> callGetManagedObjects nmBus nmObjectTreePath
  where
    go = getId <=< M.lookup nmActiveInterface
    getId m =
      fromVariant
        =<< (\t -> if t `elem` contypes then M.lookup "Id" m else Nothing)
        =<< fromVariant
        =<< M.lookup "Type" m
 readState :: EthIO [T.Text]
 readState = M.elems <$> (readMVar =<< asks plugState)
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@ -1,10 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- 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 DBus
 import Data.Internal.DBus
 import RIO
 import qualified RIO.Text as T
@ -12,15 +13,14 @@ import Xmobar.Plugins.Common
 startBacklight
  :: (MonadUnliftIO m, RealFrac a)
-  => Maybe BusName
+  => Maybe FilePath
  -> Maybe FilePath
  -> ((Maybe a -> DIO SimpleApp SesClient ()) -> DIO SimpleApp SesClient ())
  -> DIO SimpleApp SesClient (Maybe a)
  -> T.Text
  -> Callback
  -> m ()
-startBacklight n name matchSignal callGetBrightness icon cb = do
+startBacklight name matchSignal callGetBrightness icon cb = do
-  withDBusClientConnection cb n name $ \c -> withDIO c $ do
+  withDBusClientConnection cb name $ \c -> withDIO c $ do
    matchSignal dpy
    dpy =<< callGetBrightness
  where
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Bluetooth plugin
 --
@ -7,18 +9,28 @@
 -- Manager. The adapter is located at path "/org/bluez/hci<X>" where X is
 -- usually 0, and each device is "/org/bluez/hci<X>/<MAC_ADDRESS>".
 --
-- Simple and somewhat crude way to do this is to have two monitors, one
+-- This plugin will reflect if the adapter is powered and if any device is
-- watching the powered state of the adaptor and one listening for connection
+-- connected to it. The rough outline for this procedure:
-- changes. The former is easy since this is just one /org/bluez/hciX. For the
+-- 1) get the adapter from the object manager
-- latter, each 'Connected' property is embedded in each individual device path
+-- 2) get all devices associated with the adapter using the object interface
-- on `org.bluez.Device1', so just watch the entire bluez bus for property
+-- 3) determine if the adapter is powered
-- changes and filter those that correspond to the aforementioned
+-- 4) determine if any devices are connected
-- interface/property. Track all this in a state which keeps the powered
+-- 5) format the icon; powered vs not powered controls the color and connected
-- property and a running list of connected devices.
+--    vs not connected controls the icon (connected bluetooth symbol has two
 --    dots flanking it)
 --
 -- Step 3 can be accomplished using the "org.bluez.Adapter1" interface and
 -- querying the "Powered" property. Step 4 can be done using the
 -- "org.bluez.Device1" interface and the "Connected" property for each device
 -- path. Since these are properties, we can asynchronously read changes to them
 -- via the "PropertiesChanged" signal.
 --
 -- If any devices are added/removed, steps 2-4 will need to be redone and any
 -- listeners will need to be updated. (TODO not sure which signals to use in
 -- determining if a device is added)
 --
 -- TODO also not sure if I need to care about multiple adapters and/or the
-- adapter changing. For now it should just get the first adaptor and only pay
+-- adapter changing.
 -- attention to devices associated with it.
 module Xmobar.Plugins.Bluetooth
  ( Bluetooth (..)
@ -35,7 +47,6 @@ import RIO
 import RIO.FilePath
 import RIO.List
 import qualified RIO.Map as M
 import qualified RIO.Set as S
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Common
 import Xmobar
@ -54,28 +65,32 @@ data Bluetooth = Bluetooth Icons Colors deriving (Read, Show)
 instance Exec Bluetooth where
  alias (Bluetooth _ _) = T.unpack btAlias
  start (Bluetooth icons colors) cb =
-    withDBusClientConnection cb Nothing (Just "bluetooth.log") $
+    withDBusClientConnection cb (Just "bluetooth.log") $ startAdapter icons colors cb
      startAdapter icons colors cb
 startAdapter
  :: Icons
  -> Colors
  -> Callback
-  -> NamedSysConnection
+  -> SysClient
  -> RIO SimpleApp ()
 startAdapter is cs cb cl = do
  state <- newMVar emptyState
-  let dpy cb' = displayIcon cb' (iconFormatter is cs)
+  let dpy = displayIcon cb (iconFormatter is cs)
-  mapRIO (PluginEnv cl state dpy cb) $ do
+  mapRIO (BTEnv cl state dpy) $ do
    ot <- getBtObjectTree
-    case findAdaptor ot of
+    case findAdapter ot of
      Nothing -> logError "could not find bluetooth adapter"
-      Just adaptor -> do
+      Just adapter -> do
-        initAdapterState adaptor
+        -- set up adapter
-        initDevicesState adaptor ot
+        initAdapter adapter
-        startAdaptorListener adaptor
+        void $ addAdaptorListener adapter
-        startConnectedListener adaptor
+        -- set up devices on the adapter (and listeners for adding/removing devices)
-        pluginDisplay
+        let devices = findDevices adapter ot
        addDeviceAddedListener adapter
        addDeviceRemovedListener adapter
        forM_ devices $ \d -> addAndInitDevice d
        -- after setting things up, show the icon based on the initialized state
        dpy
 --------------------------------------------------------------------------------
 -- Icon Display
@ -100,18 +115,43 @@ iconFormatter (iconConn, iconDisc) cs powered connected =
 --------------------------------------------------------------------------------
 -- 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
 -- is to track the shared state of the bluetooth adaptor and its devices using
 -- an MVar.
-type BTIO = PluginIO BtState SysClient
+data BTEnv c = BTEnv
  { btClient :: !c
  , btState :: !(MVar BtState)
  , btDisplay :: !(BTIO ())
  , btEnv :: !SimpleApp
  }
 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 SysClient)
 data BTDevice = BTDevice
  { btDevConnected :: Maybe Bool
  , btDevSigHandler :: SignalHandler
  }
 type ConnectedDevices = M.Map ObjectPath BTDevice
 data BtState = BtState
-  { btDevices :: S.Set ObjectPath
+  { btDevices :: ConnectedDevices
  , btPowered :: Maybe Bool
  }
 emptyState :: BtState
 emptyState =
  BtState
-    { btDevices = S.empty
+    { btDevices = M.empty
    , btPowered = Nothing
    }
@ -119,33 +159,24 @@ readState :: BTIO (Maybe Bool, Bool)
 readState = do
  p <- readPowered
  c <- readDevices
-  return (p, not $ null c)
+  return (p, anyDevicesConnected c)
 modifyState :: (BtState -> BTIO (BtState, a)) -> BTIO a
 modifyState f = do
-  m <- asks plugState
+  m <- asks btState
  modifyMVar m f
 beforeDisplay :: BTIO () -> BTIO ()
-beforeDisplay f = f >> pluginDisplay
+beforeDisplay f = f >> join (asks btDisplay)
 --------------------------------------------------------------------------------
 -- Object manager
-findAdaptor :: ObjectTree -> Maybe ObjectPath
+findAdapter :: ObjectTree -> Maybe ObjectPath
-findAdaptor = find (("/org/bluez/hci" `isPrefixOf`) . formatObjectPath) . M.keys
+findAdapter = find (("/org/bluez/hci" `isPrefixOf`) . formatObjectPath) . M.keys
-- | Search the object tree for devices which are in a connected state.
+findDevices :: ObjectPath -> ObjectTree -> [ObjectPath]
-- Return the object path for said devices.
+findDevices adapter = filter (adaptorHasDevice adapter) . M.keys
 findConnectedDevices :: ObjectPath -> ObjectTree -> [ObjectPath]
 findConnectedDevices adaptor =
  filter (adaptorHasDevice adaptor) . M.keys . M.filter isConnectedDev
  where
    isConnectedDev m = Just True == lookupState m
    lookupState =
      fromVariant
        <=< M.lookup (memberNameT devConnected)
        <=< M.lookup devInterface
 adaptorHasDevice :: ObjectPath -> ObjectPath -> Bool
 adaptorHasDevice adaptor device = case splitPathNoRoot device of
@ -168,14 +199,49 @@ getBtObjectTree = callGetManagedObjects btBus btOMPath
 btOMPath :: ObjectPath
 btOMPath = objectPath_ "/"
 addBtOMListener
  :: ( HasClient env
     , SafeClient c
     , MonadReader (env c) m
     , HasLogFunc (env c)
     , MonadUnliftIO m
     )
  => SignalCallback m
  -> m ()
 addBtOMListener sc = void $ addInterfaceAddedListener btBus btOMPath sc
 addDeviceAddedListener :: ObjectPath -> BTIO ()
 addDeviceAddedListener adapter = addBtOMListener addDevice
  where
    addDevice = pathCallback adapter $ \d ->
      addAndInitDevice d
 addDeviceRemovedListener :: ObjectPath -> BTIO ()
 addDeviceRemovedListener adapter =
  addBtOMListener remDevice
  where
    remDevice = pathCallback adapter $ \d -> do
      old <- removeDevice d
      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
  when (adaptorHasDevice adapter d) $ beforeDisplay $ f d
 pathCallback _ _ _ = return ()
 --------------------------------------------------------------------------------
 -- Adapter
-- | Get powered state of adaptor and log the result
+initAdapter :: ObjectPath -> BTIO ()
-initAdapterState :: ObjectPath -> BTIO ()
+initAdapter adapter = do
 initAdapterState 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"
  putPowered $ fromSingletonVariant reply
  where
    adapter_ = displayWrapQuote $ displayObjectPath adapter
 matchBTProperty
  :: ( SafeClient c
@ -188,23 +254,40 @@ matchBTProperty
  -> m (Maybe MatchRule)
 matchBTProperty p = matchPropertyFull btBus (Just p)
-- | Start a listener that monitors changes to the powered state of an adaptor
+withBTPropertyRule
-startAdaptorListener :: ObjectPath -> BTIO ()
+  :: ( SafeClient c
-startAdaptorListener adaptor = do
+     , MonadReader (env c) m
-  res <- matchBTProperty adaptor
+     , HasLogFunc (env c)
     , HasClient env
     , MonadUnliftIO m
     , IsVariant a
     )
  => ObjectPath
  -> (Maybe a -> m ())
  -> InterfaceName
  -> T.Text
  -> m (Maybe SignalHandler)
 withBTPropertyRule path update iface prop = do
  res <- matchBTProperty path
  case res of
-    Just rule -> void $ addMatchCallback rule callback
+    Just rule -> Just <$> addMatchCallback rule (signalToUpdate . matchConnected)
    Nothing -> do
      logError $
        "could not add listener for prop "
-          <> displayMemberName adaptorPowered
+          <> prop_
          <> " on path "
-          <> displayObjectPath adaptor
+          <> path_
      return Nothing
  where
    path_ = displayObjectPath path
    prop_ = Utf8Builder $ encodeUtf8Builder prop
    signalToUpdate = withSignalMatch update
    matchConnected = matchPropertyChanged iface prop
 addAdaptorListener :: ObjectPath -> BTIO (Maybe SignalHandler)
 addAdaptorListener adaptor =
  withBTPropertyRule adaptor procMatch adapterInterface adaptorPowered
  where
    callback sig =
      withNestedDBusClientConnection Nothing Nothing $
        withSignalMatch procMatch $
          matchPropertyChanged adaptorInterface adaptorPowered sig
    procMatch = beforeDisplay . putPowered
 callGetPowered
@ -217,58 +300,88 @@ callGetPowered
  => ObjectPath
  -> m [Variant]
 callGetPowered adapter =
-  callPropertyGet btBus adapter adaptorInterface adaptorPowered
+  callPropertyGet btBus adapter adapterInterface $
    memberName_ $
      T.unpack adaptorPowered
 putPowered :: Maybe Bool -> BTIO ()
 putPowered ds = modifyState $ \s -> return (s {btPowered = ds}, ())
 readPowered :: BTIO (Maybe Bool)
-readPowered = fmap btPowered $ readMVar =<< asks plugState
+readPowered = fmap btPowered $ readMVar =<< asks btState
-adaptorInterface :: InterfaceName
+adapterInterface :: InterfaceName
-adaptorInterface = interfaceName_ "org.bluez.Adapter1"
+adapterInterface = interfaceName_ "org.bluez.Adapter1"
-adaptorPowered :: MemberName
+adaptorPowered :: T.Text
 adaptorPowered = "Powered"
 --------------------------------------------------------------------------------
 -- Devices
-initDevicesState :: ObjectPath -> ObjectTree -> BTIO ()
+addAndInitDevice :: ObjectPath -> BTIO ()
-initDevicesState adaptor ot = do
+addAndInitDevice device = do
-  let devices = findConnectedDevices adaptor ot
+  res <- addDeviceListener device
-  modifyState $ \s -> return (s {btDevices = S.fromList devices}, ())
+  case res of
-
+    Just handler -> do
-startConnectedListener :: ObjectPath -> BTIO ()
+      logInfo $ "initializing device at path " <> device_
-startConnectedListener adaptor = do
+      initDevice handler device
-  reply <- matchPropertyFull btBus Nothing
+    Nothing -> logError $ "could not initialize device at path " <> device_
  case reply of
    Just rule -> do
      void $ addMatchCallbackSignal rule callback
      logInfo $ "Started listening for device connections on " <> adaptor_
    Nothing -> logError "Could not listen for connection changes"
  where
-    adaptor_ = displayWrapQuote $ displayObjectPath adaptor
+    device_ = displayWrapQuote $ displayObjectPath device
    callback sig =
      withNestedDBusClientConnection Nothing Nothing $ do
        let devpath = signalPath sig
        when (adaptorHasDevice adaptor devpath) $
          withSignalMatch (update devpath) $
            matchConnected $
              signalBody sig
    matchConnected = matchPropertyChanged devInterface devConnected
    update _ Nothing = return ()
    update devpath (Just x) = do
      let f = if x then S.insert else S.delete
      beforeDisplay $
        modifyState $
          \s -> return (s {btDevices = f devpath $ btDevices s}, ())
-readDevices :: BTIO (S.Set ObjectPath)
+initDevice :: SignalHandler -> ObjectPath -> BTIO ()
-readDevices = fmap btDevices $ readMVar =<< asks plugState
+initDevice sh device = do
  reply <- callGetConnected device
  void $
    insertDevice device $
      BTDevice
        { btDevConnected = fromVariant =<< listToMaybe reply
        , btDevSigHandler = sh
        }
 addDeviceListener :: ObjectPath -> BTIO (Maybe SignalHandler)
 addDeviceListener device =
  withBTPropertyRule device procMatch devInterface devConnected
  where
    procMatch = beforeDisplay . void . updateDevice device
 callGetConnected
  :: ( SafeClient c
     , HasClient env
     , MonadReader (env c) m
     , HasLogFunc (env c)
     , MonadUnliftIO m
     )
  => ObjectPath
  -> m [Variant]
 callGetConnected p =
  callPropertyGet btBus p devInterface $
    memberName_ (T.unpack devConnected)
 insertDevice :: ObjectPath -> BTDevice -> BTIO Bool
 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 = 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 = 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
 devInterface :: InterfaceName
 devInterface = interfaceName_ "org.bluez.Device1"
-devConnected :: MemberName
+devConnected :: T.Text
 devConnected = "Connected"
--- a/lib/Xmobar/Plugins/ClevoKeyboard.hs
+++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Clevo Keyboard plugin
 --
@ -10,7 +12,6 @@ module Xmobar.Plugins.ClevoKeyboard
  )
 where
 import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import Xmobar
@ -24,9 +25,4 @@ ckAlias = "clevokeyboard"
 instance Exec ClevoKeyboard where
  alias (ClevoKeyboard _) = T.unpack ckAlias
  start (ClevoKeyboard icon) =
-    startBacklight
+    startBacklight (Just "clevo_kbd.log") matchSignalCK callGetBrightnessCK icon
      (Just "org.xmobar.clevo")
      (Just "clevo_kbd.log")
      matchSignalCK
      callGetBrightnessCK
      icon
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@ -1,19 +1,17 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Xmobar.Plugins.Common
  ( colorText
  , startListener
  , procSignalMatch
  , na
  , fromSingletonVariant
  , withNestedDBusClientConnection
  , withDBusClientConnection
  , Callback
  , Colors (..)
  , displayMaybe
  , displayMaybe'
  , xmobarFGColor
  , PluginEnv (..)
  , PluginIO
  , pluginDisplay
  )
 where
@ -25,28 +23,6 @@ import RIO
 import qualified RIO.Text as T
 import XMonad.Hooks.DynamicLog (xmobarColor)
 data PluginEnv s c = PluginEnv
  { plugClient :: !(NamedConnection c)
  , plugState :: !(MVar s)
  , plugDisplay :: !(Callback -> PluginIO s c ())
  , plugCallback :: !Callback
  , plugEnv :: !SimpleApp
  }
 pluginDisplay :: PluginIO s c ()
 pluginDisplay = do
  cb <- asks plugCallback
  dpy <- asks plugDisplay
  dpy cb
 type PluginIO s c = RIO (PluginEnv s c)
 instance HasClient (PluginEnv s) where
  clientL = lens plugClient (\x y -> x {plugClient = y})
 instance HasLogFunc (PluginEnv s c) where
  logFuncL = lens plugEnv (\x y -> x {plugEnv = y}) . logFuncL
 -- use string here since all the callbacks in xmobar use strings :(
 type Callback = String -> IO ()
@ -57,7 +33,8 @@ data Colors = Colors
  deriving (Eq, Show, Read)
 startListener
-  :: ( HasClient env
+  :: ( HasLogFunc (env c)
     , HasClient env
     , MonadReader (env c) m
     , MonadUnliftIO m
     , SafeClient c
@ -99,42 +76,14 @@ displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na)
 withDBusClientConnection
  :: (MonadUnliftIO m, SafeClient c)
  => Callback
  -> Maybe BusName
  -> Maybe FilePath
-  -> (NamedConnection c -> RIO SimpleApp ())
+  -> (c -> RIO SimpleApp ())
  -> m ()
-withDBusClientConnection cb n logfile f =
+withDBusClientConnection cb logfile f =
  maybe (run stderr) (`withLogFile` run) logfile
  where
    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 n
+        runRIO env $ displayMaybe' cb f =<< getDBusClient
 -- | Run a plugin action with a new DBus client and logfile path. This is
 -- necessary for DBus callbacks which run in separate threads, which will
 -- usually fire when the parent thread already exited and killed off its DBus
 -- connection and closed its logfile. NOTE: unlike 'withDBusClientConnection'
 -- this function will open and new logfile and client connection and close both
 -- on completion. 'withDBusClientConnection' will only close the log file but
 -- keep the client connection active upon termination; this client will only be
 -- killed when the entire process is killed. This distinction is important
 -- because callbacks only need ephemeral connections, while listeners (started
 -- with 'withDBusClientConnection') need long-lasting connections.
 withNestedDBusClientConnection
  :: (MonadUnliftIO m, SafeClient c, MonadReader (PluginEnv s c) m)
  => Maybe BusName
  -> Maybe FilePath
  -> PluginIO s c ()
  -> m ()
 withNestedDBusClientConnection n logfile f = do
  dpy <- asks plugDisplay
  s <- asks plugState
  cb <- asks plugCallback
  let run h = do
        logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
        withLogFunc logOpts $ \lf -> do
          env <- mkSimpleApp lf Nothing
          runRIO env $ withDBusClient_ n $ \cl -> mapRIO (PluginEnv cl s dpy cb) f
  maybe (run stderr) (`withLogFile` run) logfile
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@ -0,0 +1,89 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 --------------------------------------------------------------------------------
 -- Device plugin
 --
 -- Display different text depending on whether or not the interface has
 -- connectivity
 module Xmobar.Plugins.Device
  ( Device (..)
  , devDep
  )
 where
 import DBus
 import Data.Internal.DBus
 import Data.Internal.XIO
 import RIO
 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)
 nmPath :: ObjectPath
 nmPath = objectPath_ "/org/freedesktop/NetworkManager"
 nmInterface :: InterfaceName
 nmInterface = interfaceName_ "org.freedesktop.NetworkManager"
 nmDeviceInterface :: InterfaceName
 nmDeviceInterface = interfaceName_ "org.freedesktop.NetworkManager.Device"
 getByIP :: MemberName
 getByIP = memberName_ "GetDeviceByIpIface"
 devSignal :: T.Text
 devSignal = "Ip4Connectivity"
 devDep :: DBusDependency_ SysClient
 devDep =
  Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
    Method_ getByIP
 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)
        { methodCallBody = [toVariant iface]
        }
 getDeviceConnected
  :: ( SafeClient c
     , HasClient env
     , MonadReader (env c) m
     , HasLogFunc (env c)
     , MonadUnliftIO m
     )
  => ObjectPath
  -> m [Variant]
 getDeviceConnected path =
  callPropertyGet networkManagerBus path nmDeviceInterface $
    memberName_ $
      T.unpack devSignal
 matchStatus :: [Variant] -> SignalMatch Word32
 matchStatus = matchPropertyChanged nmDeviceInterface devSignal
 instance Exec Device where
  alias (Device (iface, _, _)) = T.unpack iface
  start (Device (iface, text, colors)) cb =
    withDBusClientConnection cb logName $ \(sys :: SysClient) -> withDIO sys $ do
      path <- getDevice iface
      displayMaybe' cb listener path
    where
      logName = Just $ T.unpack $ T.concat ["device@", iface, ".log"]
      listener path = do
        res <- matchPropertyFull networkManagerBus (Just path)
        case res of
          Just rule -> startListener rule (getDeviceConnected path) matchStatus chooseColor' cb
          Nothing -> logError "could not start listener"
      chooseColor' = return . (\s -> colorText colors s text) . (> 1)
--- a/lib/Xmobar/Plugins/IntelBacklight.hs
+++ b/lib/Xmobar/Plugins/IntelBacklight.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Intel backlight plugin
 --
@ -10,7 +12,6 @@ module Xmobar.Plugins.IntelBacklight
  )
 where
 import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Brightness.IntelBacklight
 import Xmobar
@ -24,9 +25,4 @@ blAlias = "intelbacklight"
 instance Exec IntelBacklight where
  alias (IntelBacklight _) = T.unpack blAlias
  start (IntelBacklight icon) =
-    startBacklight
+    startBacklight (Just "intel_backlight.log") matchSignalIB callGetBrightnessIB icon
      (Just "org.xmobar.intelbacklight")
      (Just "intel_backlight.log")
      matchSignalIB
      callGetBrightnessIB
      icon
--- a/lib/Xmobar/Plugins/Screensaver.hs
+++ b/lib/Xmobar/Plugins/Screensaver.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- Screensaver plugin
 --
@ -11,7 +13,6 @@ module Xmobar.Plugins.Screensaver
 where
 import Data.Internal.DBus
 import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Screensaver
 import Xmobar
@ -25,12 +26,8 @@ ssAlias = "screensaver"
 instance Exec Screensaver where
  alias (Screensaver _) = T.unpack ssAlias
  start (Screensaver (text, colors)) cb =
-    withDBusClientConnection
+    withDBusClientConnection cb (Just "screensaver.log") $ \cl -> withDIO cl $ do
-      cb
+      matchSignal dpy
-      (Just "org.xmobar.screensaver")
+      dpy =<< callQuery
      (Just "screensaver.log")
      $ \cl -> withDIO cl $ do
        matchSignal dpy
        dpy =<< callQuery
    where
      dpy = displayMaybe cb $ return . (\s -> colorText colors s text)
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@ -0,0 +1,173 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 -- 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 (..)
  , vpnAlias
  , vpnDep
  )
 where
 import DBus
 import Data.Internal.DBus
 import Data.Internal.XIO
 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
 import Xmobar
 import Xmobar.Plugins.Common
 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 (Just "vpn.log") $ \c -> do
      let dpy = displayMaybe cb iconFormatter . Just =<< readState
      s <- newEmptyMVar
      mapRIO (VEnv c s dpy) $ do
        initState
        vpnAddedListener addedCallback
        vpnRemovedListener removedCallback
        dpy
    where
      iconFormatter b = return $ colorText colors b text
 --------------------------------------------------------------------------------
 -- 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
 -- case of multiple VPNs being active at once without puking.
 data VEnv c = VEnv
  { vClient :: !c
  , vState :: !(MVar VPNState)
  , vDisplay :: !(VIO ())
  , vEnv :: !SimpleApp
  }
 instance SafeClient c => HasLogFunc (VEnv c) where
  logFuncL = lens vEnv (\x y -> x {vEnv = y}) . logFuncL
 instance HasClient VEnv where
  clientL = lens vClient (\x y -> x {vClient = y})
 type VIO = RIO (VEnv SysClient)
 type VPNState = S.Set ObjectPath
 initState :: VIO ()
 initState = do
  ot <- getVPNObjectTree
  s <- asks vState
  putMVar s $ findTunnels ot
 readState :: VIO Bool
 readState = fmap (not . null) . readMVar =<< asks vState
 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
 getVPNObjectTree
  :: ( 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
  :: ( SafeClient c
     , HasClient env
     , MonadReader (env c) m
     , HasLogFunc (env c)
     , MonadUnliftIO m
     )
  => SignalCallback m
  -> m ()
 vpnAddedListener cb = void $ addInterfaceAddedListener vpnBus vpnPath cb
 vpnRemovedListener
  :: ( SafeClient c
     , HasClient env
     , MonadReader (env c) m
     , HasLogFunc (env c)
     , MonadUnliftIO m
     )
  => SignalCallback m
  -> m ()
 vpnRemovedListener cb = void $ addInterfaceRemovedListener vpnBus vpnPath cb
 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))
 addedCallback _ = return ()
 removedCallback :: SignalCallback VIO
 removedCallback [device, interfaces] =
  beforeDisplay $
    updateDevice S.delete device $
      fromMaybe [] $
        fromVariant interfaces
 removedCallback _ = return ()
 updateDevice
  :: (ObjectPath -> VPNState -> VPNState)
  -> Variant
  -> [T.Text]
  -> VIO ()
 updateDevice f device interfaces =
  when (vpnDeviceTun `elem` interfaces) $
    forM_ d $
      updateState f
  where
    d = fromVariant device :: Maybe ObjectPath
 --------------------------------------------------------------------------------
 -- DBus Interface
 vpnBus :: BusName
 vpnBus = busName_ "org.freedesktop.NetworkManager"
 vpnPath :: ObjectPath
 vpnPath = objectPath_ "/org/freedesktop"
 vpnDeviceTun :: T.Text
 vpnDeviceTun = "org.freedesktop.NetworkManager.Device.Tun"
 vpnAlias :: T.Text
 vpnAlias = "vpn"
 vpnDep :: DBusDependency_ SysClient
 vpnDep =
  Endpoint networkManagerPkgs networkManagerBus vpnPath omInterface $
    Method_ getManagedObjects
--- a/package.yaml
+++ b/package.yaml
@ -9,47 +9,9 @@ extra-source-files:
 - README.md
 - fourmolu.yaml
 - make_pkgs
- runtime_pkgs
+- icons/*
 - assets/icons/*
 - assets/sound/*
 - scripts/*
-
+- sound/*
 default-extensions:
  - OverloadedStrings
  - FlexibleContexts
  - FlexibleInstances
  - InstanceSigs
  - MultiParamTypeClasses
  - EmptyCase
  - LambdaCase
  - MultiWayIf
  - NamedFieldPuns
  - TupleSections
  - DeriveFoldable
  - DeriveFunctor
  - DeriveGeneric
  - DeriveLift
  - DeriveTraversable
  - DerivingStrategies
  - DeriveDataTypeable
  - EmptyDataDecls
  - PartialTypeSignatures
  - GeneralizedNewtypeDeriving
  - StandaloneDeriving
  - BangPatterns
  - TypeOperators
  - ScopedTypeVariables
  - TypeApplications
  - ConstraintKinds
  - RankNTypes
  - GADTs
  - DefaultSignatures
  - NoImplicitPrelude
  - FunctionalDependencies
  - DataKinds
  - TypeFamilies
  - BinaryLiterals
  - ViewPatterns
 dependencies:
  - rio >= 0.1.21.0
@ -75,19 +37,13 @@ dependencies:
  - unliftio >= 0.2.21.0
  - optparse-applicative >= 0.16.1.0
 ghc-options:
 - -Wall
 - -Wcompat
 - -Widentities
 - -Wincomplete-record-updates
 - -Wincomplete-uni-patterns
 - -Wredundant-constraints
 - -Wpartial-fields
 - -Werror
 - -O2
 library:
  source-dirs: lib/
  ghc-options:
    - -Wall
    - -Werror
    - -Wpartial-fields
    - -O2
 executables:
  xmobar: &bin
@ -97,15 +53,21 @@ executables:
     - xmonad-config
    ghc-options:
      - -threaded
      - -Wall
      - -Werror
      - -Wpartial-fields
      - -O2
  xmonad: 
    <<: *bin
    main:                xmonad.hs
    ghc-options:
      - -threaded
      - -Wall
      - -Werror
      - -Wpartial-fields
      - -O2
      # this is needed to avoid writing super complex layout types
      - -fno-warn-missing-signatures
  vbox-start:
    <<: *bin
    main:                vbox-start.hs
    ghc-options:
      - -threaded
--- a/scripts/runtime_pkgs
+++ b/scripts/runtime_pkgs
--- a/scripts/screencap
+++ b/scripts/screencap
@ -1,22 +0,0 @@
 #! /bin/bash
 ## capture a screenshot using scrot
 SS_DIR="$XDG_CACHE_HOME/screenshots"
 while getopts ":sw" opt; do
 	case ${opt} in
 		s)
 			scrot "$SS_DIR/desktop/%Y-%m-%d-%H:%M:%S_desktop.png"
 			notify-send "Screen captured"
 			;;
 		w)
 			scrot -u "$SS_DIR/window/%Y-%m-%d-%H:%M:%S-\$wx\$h.png"
 			notify-send "Window captured"
 			;;
 		\?)
 			echo "invalid option, read the code"
 			;;
 	esac
 done
--- a/scripts/screenlock
+++ b/scripts/screenlock
@ -1,61 +0,0 @@
 #! /bin/bash
 ## lock the screen using i3lock (and maybe suspend)
 ## usage: screenlock [SUSPEND]
 # WORKAROUND make the date show up in the right place on 2+ monitor setups
 # I want it to only show up on the primary screen, so use xrandr to get the
 # dimensions and position of the primary monitor and calculate the date position
 # from that
 geometry=$(xrandr | sed -n 's/^.*primary \([0-9]*\)x[0-9]*+\([0-9]\)*+[0-9]* .*/\1 \2/p')
 width=$(echo "$geometry" | cut -f1 -d" ")
 xpos=$(echo "$geometry" | cut -f2 -d" ")
 xoffset=$(("$xpos" + "$width" / 2))
 datepos="$xoffset:600"
 # lock and fork so we can suspend with the screen locked
 i3lock --color=000000 \
       --pass-media-keys \
       --nofork \
       --ignore-empty-password \
       --screen=0 \
       --indicator \
       --inside-color=00000055 \
       --insidever-color=00000055 \
       --insidewrong-color=00000055 \
       --ring-color=555555ff \
       --ringwrong-color=ff3333ff \
       --ringver-color=99ceffff \
       --keyhl-color=99ceffff \
       --bshl-color=9523ffff \
       --line-color=00000000 \
       --separator-color=00000000 \
       --clock \
       --verif-color=99ceffff \
       --wrong-color=ff8282ff \
       --time-color=ffffffff \
       --time-size=72 \
       --time-str="%H:%M" \
       --date-color=ffffffff \
       --date-size=42 \
       --date-str="%b %d, %Y" \
       --date-align 0 \
       --date-pos="$datepos" \
       --wrong-size=72 \
       --verif-size=72 \
       --radius=300 \
       --ring-width=25 &
 # suspend if we want, and if this machine is currently using a battery
 batpath=/sys/class/power_supply/BAT0/status
 if [ -f "$batpath" ] && \
       [ "$(cat $batpath)" == "Discharging" ] && \
       [ "$1" == "true" ]; then
    systemctl suspend
 fi
 # block until the screen is unlocked (since xss-lock expects the locker to exit
 # only when unlocked)
 wait
--- a/assets/sound/smb_fireball.wav
+++ b/assets/sound/smb_fireball.wav
--- a/assets/sound/smb_pipe.wav
+++ b/assets/sound/smb_pipe.wav
--- a/assets/sound/smb_powerup.wav
+++ b/assets/sound/smb_powerup.wav
--- a/stack.yaml
+++ b/stack.yaml
@ -17,8 +17,8 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-19.33
+#resolver: lts-17.4
-#resolver: nightly-2022-03-03
+resolver: nightly-2022-03-03
 # User packages to be built.
 # Various formats can be used as shown in the example below.