REF reformat everything with fourmolu

ENH use fourmolu
Revert "WIP use unliftio everywhere-ish"
2022-12-30 14:58:23 -05:00 · 2022-12-30 12:21:53 -05:00 · 2022-12-30 10:56:09 -05:00 · 2022-12-30 10:38:21 -05:00 · 2022-12-29 15:22:48 -05:00
35 changed files with 2534 additions and 2456 deletions
--- a/.stylish-haskell.yaml
+++ b/.stylish-haskell.yaml
@ -1,357 +0,0 @@
 # stylish-haskell configuration file
 # ==================================
 # The stylish-haskell tool is mainly configured by specifying steps. These steps
 # are a list, so they have an order, and one specific step may appear more than
 # once (if needed). Each file is processed by these steps in the given order.
 steps:
  # Convert some ASCII sequences to their Unicode equivalents. This is disabled
  # by default.
  # - unicode_syntax:
  #     # In order to make this work, we also need to insert the UnicodeSyntax
  #     # language pragma. If this flag is set to true, we insert it when it's
  #     # not already present. You may want to disable it if you configure
  #     # language extensions using some other method than pragmas. Default:
  #     # true.
  #     add_language_pragma: true
  # Format module header
  #
  # Currently, this option is not configurable and will format all exports and
  # module declarations to minimize diffs
  #
  # - module_header:
  #     # How many spaces use for indentation in the module header.
  #     indent: 4
  #
  #     # Should export lists be sorted?  Sorting is only performed within the
  #     # export section, as delineated by Haddock comments.
  #     sort: true
  #
  #     # See `separate_lists` for the `imports` step.
  #     separate_lists: true
  # Format record definitions. This is disabled by default.
  #
  # You can control the layout of record fields. The only rules that can't be configured
  # are these:
  #
  # - "|" is always aligned with "="
  # - "," in fields is always aligned with "{"
  # - "}" is likewise always aligned with "{"
  #
  # - records:
  #     # How to format equals sign between type constructor and data constructor.
  #     # Possible values:
  #     # - "same_line" -- leave "=" AND data constructor on the same line as the type constructor.
  #     # - "indent N" -- insert a new line and N spaces from the beginning of the next line.
  #     equals: "indent 2"
  #
  #     # How to format first field of each record constructor.
  #     # Possible values:
  #     # - "same_line" -- "{" and first field goes on the same line as the data constructor.
  #     # - "indent N" -- insert a new line and N spaces from the beginning of the data constructor
  #     first_field: "indent 2"
  #
  #     # How many spaces to insert between the column with "," and the beginning of the comment in the next line.
  #     field_comment: 2
  #
  #     # How many spaces to insert before "deriving" clause. Deriving clauses are always on separate lines.
  #     deriving: 2
  #
  #     # How many spaces to insert before "via" clause counted from indentation of deriving clause
  #     # Possible values:
  #     # - "same_line" -- "via" part goes on the same line as "deriving" keyword.
  #     # - "indent N" -- insert a new line and N spaces from the beginning of "deriving" keyword.
  #     via: "indent 2"
  #
  #     # Sort typeclass names in the "deriving" list alphabetically.
  #     sort_deriving: true
  #
  #     # Wheter or not to break enums onto several lines
  #     #
  #     # Default: false
  #     break_enums: false
  #
  #     # Whether or not to break single constructor data types before `=` sign
  #     #
  #     # Default: true
  #     break_single_constructors: true
  #
  #     # Whether or not to curry constraints on function.
  #     #
  #     # E.g: @allValues :: Enum a => Bounded a => Proxy a -> [a]@
  #     #
  #     # Instead of @allValues :: (Enum a, Bounded a) => Proxy a -> [a]@
  #     #
  #     # Default: false
  #     curried_context: false
  # Align the right hand side of some elements.  This is quite conservative
  # and only applies to statements where each element occupies a single
  # line.
  # Possible values:
  # - always - Always align statements.
  # - adjacent - Align statements that are on adjacent lines in groups.
  # - never - Never align statements.
  # All default to always.
  - simple_align:
      cases: always
      top_level_patterns: always
      records: always
      multi_way_if: always
  # Import cleanup
  - imports:
      # There are different ways we can align names and lists.
      #
      # - global: Align the import names and import list throughout the entire
      #   file.
      #
      # - file: Like global, but don't add padding when there are no qualified
      #   imports in the file.
      #
      # - group: Only align the imports per group (a group is formed by adjacent
      #   import lines).
      #
      # - none: Do not perform any alignment.
      #
      # Default: global.
      align: global
      # The following options affect only import list alignment.
      #
      # List align has following options:
      #
      # - after_alias: Import list is aligned with end of import including
      #   'as' and 'hiding' keywords.
      #
      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
      #   >                                          init, last, length)
      #
      # - with_alias: Import list is aligned with start of alias or hiding.
      #
      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
      #   >                                 init, last, length)
      #
      # - with_module_name: Import list is aligned `list_padding` spaces after
      #   the module name.
      #
      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
      #                          init, last, length)
      #
      #   This is mainly intended for use with `pad_module_names: false`.
      #
      #   > import qualified Data.List as List (concat, foldl, foldr, head,
      #                          init, last, length, scanl, scanr, take, drop,
      #                          sort, nub)
      #
      # - new_line: Import list starts always on new line.
      #
      #   > import qualified Data.List      as List
      #   >     (concat, foldl, foldr, head, init, last, length)
      #
      # - repeat: Repeat the module name to align the import list.
      #
      #   > import qualified Data.List      as List (concat, foldl, foldr, head)
      #   > import qualified Data.List      as List (init, last, length)
      #
      # Default: after_alias
      list_align: after_alias
      # Right-pad the module names to align imports in a group:
      #
      # - true: a little more readable
      #
      #   > import qualified Data.List       as List (concat, foldl, foldr,
      #   >                                           init, last, length)
      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
      #   >                                           init, last, length)
      #
      # - false: diff-safe
      #
      #   > import qualified Data.List as List (concat, foldl, foldr, init,
      #   >                                     last, length)
      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
      #   >                                           init, last, length)
      #
      # Default: true
      pad_module_names: true
      # Long list align style takes effect when import is too long. This is
      # determined by 'columns' setting.
      #
      # - inline: This option will put as much specs on same line as possible.
      #
      # - new_line: Import list will start on new line.
      #
      # - new_line_multiline: Import list will start on new line when it's
      #   short enough to fit to single line. Otherwise it'll be multiline.
      #
      # - multiline: One line per import list entry.
      #   Type with constructor list acts like single import.
      #
      #   > import qualified Data.Map as M
      #   >     ( empty
      #   >     , singleton
      #   >     , ...
      #   >     , delete
      #   >     )
      #
      # Default: inline
      long_list_align: multiline
      # Align empty list (importing instances)
      #
      # Empty list align has following options
      #
      # - inherit: inherit list_align setting
      #
      # - right_after: () is right after the module name:
      #
      #   > import Vector.Instances ()
      #
      # Default: inherit
      empty_list_align: inherit
      # List padding determines indentation of import list on lines after import.
      # This option affects 'long_list_align'.
      #
      # - <integer>: constant value
      #
      # - module_name: align under start of module name.
      #   Useful for 'file' and 'group' align settings.
      #
      # Default: 4
      list_padding: 4
      # Separate lists option affects formatting of import list for type
      # or class. The only difference is single space between type and list
      # of constructors, selectors and class functions.
      #
      # - true: There is single space between Foldable type and list of it's
      #   functions.
      #
      #   > import Data.Foldable (Foldable (fold, foldl, foldMap))
      #
      # - false: There is no space between Foldable type and list of it's
      #   functions.
      #
      #   > import Data.Foldable (Foldable(fold, foldl, foldMap))
      #
      # Default: true
      separate_lists: true
      # Space surround option affects formatting of import lists on a single
      # line. The only difference is single space after the initial
      # parenthesis and a single space before the terminal parenthesis.
      #
      # - true: There is single space associated with the enclosing
      #   parenthesis.
      #
      #   > import Data.Foo ( foo )
      #
      # - false: There is no space associated with the enclosing parenthesis
      #
      #   > import Data.Foo (foo)
      #
      # Default: false
      space_surround: false
      # Enabling this argument will use the new GHC lib parse to format imports.
      #
      # This currently assumes a few things, it will assume that you want post
      # qualified imports. It is also not as feature complete as the old
      # imports formatting.
      #
      # It does not remove redundant lines or merge lines. As such, the full
      # feature scope is still pending.
      #
      # It _is_ however, a fine alternative if you are using features that are
      # not parseable by haskell src extensions and you're comfortable with the
      # presets.
      #
      # Default: false
      ghc_lib_parser: false
  # Language pragmas
  - language_pragmas:
      # We can generate different styles of language pragma lists.
      #
      # - vertical: Vertical-spaced language pragmas, one per line.
      #
      # - compact: A more compact style.
      #
      # - compact_line: Similar to compact, but wrap each line with
      #   `{-#LANGUAGE #-}'.
      #
      # Default: vertical.
      style: vertical
      # Align affects alignment of closing pragma brackets.
      #
      # - true: Brackets are aligned in same column.
      #
      # - false: Brackets are not aligned together. There is only one space
      #   between actual import and closing bracket.
      #
      # Default: true
      align: true
      # stylish-haskell can detect redundancy of some language pragmas. If this
      # is set to true, it will remove those redundant pragmas. Default: true.
      remove_redundant: true
      # Language prefix to be used for pragma declaration, this allows you to
      # use other options non case-sensitive like "language" or "Language".
      # If a non correct String is provided, it will default to: LANGUAGE.
      language_prefix: LANGUAGE
  # Replace tabs by spaces. This is disabled by default.
  # - tabs:
  #     # Number of spaces to use for each tab. Default: 8, as specified by the
  #     # Haskell report.
  #     spaces: 8
  # Remove trailing whitespace
  - trailing_whitespace: {}
  # Squash multiple spaces between the left and right hand sides of some
  # elements into single spaces. Basically, this undoes the effect of
  # simple_align but is a bit less conservative.
  # - squash: {}
 # A common setting is the number of columns (parts of) code will be wrapped
 # to. Different steps take this into account.
 #
 # Set this to null to disable all line wrapping.
 #
 # Default: 80.
 columns: 80
 # By default, line endings are converted according to the OS. You can override
 # preferred format here.
 #
 # - native: Native newline format. CRLF on Windows, LF on other OSes.
 #
 # - lf: Convert to LF ("\n").
 #
 # - crlf: Convert to CRLF ("\r\n").
 #
 # Default: native.
 newline: native
 # Sometimes, language extensions are specified in a cabal file or from the
 # command line instead of using language pragmas in the file. stylish-haskell
 # needs to be aware of these, so it can parse the file correctly.
 #
 # No language extensions are enabled by default.
 # language_extensions:
  # - TemplateHaskell
  # - QuasiQuotes
 # Attempt to find the cabal file in ancestors of the current directory, and
 # parse options (currently only language extensions) from that.
 #
 # Default: true
 cabal: true
--- a/bin/vbox-start.hs
+++ b/bin/vbox-start.hs
@ -1,7 +1,6 @@
-{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 --------------------------------------------------------------------------------
 -- | Start a VirtualBox instance with a sentinel wrapper process.
 --
 -- The only reason why this is needed is because I want to manage virtualboxes
@ -15,21 +14,16 @@
 -- until its PID exits. By monitoring this wrapper, the dynamic workspace only
 -- has one process to track and will maintain the workspace throughout the
 -- lifetime of the VM.
 module Main (main) where
-import qualified Data.ByteString.Lazy.UTF8             as BU
+import qualified Data.ByteString.Lazy.UTF8 as BU
-
+import RIO
-import           RIO
+import RIO.Process
-import           RIO.Process
+import qualified RIO.Text as T
-import qualified RIO.Text                              as T
+import System.Environment
-
+import Text.XML.Light
-import           Text.XML.Light
+import XMonad.Internal.Concurrent.VirtualBox
-
+import XMonad.Internal.IO
 import           System.Environment
 import           XMonad.Internal.Concurrent.VirtualBox
 import           XMonad.Internal.IO
 main :: IO ()
 main = do
@ -48,7 +42,6 @@ runAndWait [n] = do
      p <- vmPID i
      liftIO $ mapM_ waitUntilExit p
    err = logError "Could not get machine ID"
 runAndWait _ = liftIO $ putStrLn "Usage: vbox-start VBOXNAME"
 vmLaunch :: T.Text -> RIO SimpleApp ()
@ -56,25 +49,28 @@ vmLaunch i = do
  rc <- proc "VBoxManage" ["startvm", T.unpack i] runProcess
  case rc of
    ExitSuccess -> return ()
-    _           -> logError $ "Failed to start VM: "
+    _ ->
-                   <> displayBytesUtf8 (encodeUtf8 i)
+      logError $
        "Failed to start VM: "
          <> displayBytesUtf8 (encodeUtf8 i)
 vmPID :: T.Text -> RIO SimpleApp (Maybe Int)
 vmPID vid = do
  (rc, out) <- proc "pgrep" ["-f", "VirtualBoxVM.*" ++ T.unpack vid] readProcessStdout
  return $ case rc of
    ExitSuccess -> readMaybe $ BU.toString out
-    _           -> Nothing
+    _ -> Nothing
 vmMachineID :: FilePath -> RIO SimpleApp (Maybe T.Text)
 vmMachineID iPath = do
  res <- tryAny $ readFileUtf8 iPath
  case res of
    Right contents -> return $ findMachineID contents
-    Left e         -> logError (displayShow e) >> return Nothing
+    Left e -> logError (displayShow e) >> return Nothing
  where
-    findMachineID c = T.stripSuffix "}"
+    findMachineID c =
-      =<< T.stripPrefix "{"
+      T.stripSuffix "}"
-      =<< (fmap T.pack . findAttr (blank_name { qName = "uuid" }))
+        =<< T.stripPrefix "{"
-      =<< (\e -> findChild (qual e "Machine") e)
+        =<< (fmap T.pack . findAttr (blank_name {qName = "uuid"}))
-      =<< parseXMLDoc c
+        =<< (\e -> findChild (qual e "Machine") e)
        =<< parseXMLDoc c
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@ -1,8 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main (main) where
 --------------------------------------------------------------------------------
 -- | Xmobar binary
 --
 -- Features:
@ -12,52 +9,47 @@ module Main (main) where
 -- * Some custom plugins (imported below)
 -- * Theme integration with xmonad (shared module imported below)
 -- * A custom Locks plugin from my own forked repo
 module Main (main) where
-import           Control.Monad
+import Control.Monad
-
+import Data.Internal.DBus
-import           Data.Internal.DBus
+import Data.Internal.Dependency
-import           Data.Internal.Dependency
+import Data.List
-import           Data.List
+import Data.Maybe
-import           Data.Maybe
+import RIO hiding (hFlush)
-
+import qualified RIO.ByteString.Lazy as BL
-import           RIO                                            hiding (hFlush)
+import RIO.Process
-import qualified RIO.ByteString.Lazy                            as BL
+import qualified RIO.Text as T
-import           RIO.Process
+import System.Environment
-import qualified RIO.Text                                       as T
+import System.IO
-
+import XMonad.Core hiding (config)
-import           System.Environment
+import XMonad.Internal.Command.Desktop
-import           System.IO
+import XMonad.Internal.Command.Power
-
+import XMonad.Internal.DBus.Brightness.ClevoKeyboard
-import           Xmobar.Plugins.Bluetooth
+import XMonad.Internal.DBus.Brightness.IntelBacklight
-import           Xmobar.Plugins.ClevoKeyboard
+import XMonad.Internal.DBus.Control
-import           Xmobar.Plugins.Device
+import XMonad.Internal.DBus.Screensaver (ssSignalDep)
-import           Xmobar.Plugins.IntelBacklight
+import qualified XMonad.Internal.Theme as XT
-import           Xmobar.Plugins.Screensaver
+import Xmobar hiding
-import           Xmobar.Plugins.VPN
+  ( iconOffset
-
+  , run
-import           XMonad.Core                                    hiding (config)
+  )
-import           XMonad.Internal.Command.Desktop
+import Xmobar.Plugins.Bluetooth
-import           XMonad.Internal.Command.Power
+import Xmobar.Plugins.ClevoKeyboard
-import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
+import Xmobar.Plugins.Common
-import           XMonad.Internal.DBus.Brightness.IntelBacklight
+import Xmobar.Plugins.Device
-import           XMonad.Internal.DBus.Control
+import Xmobar.Plugins.IntelBacklight
-import           XMonad.Internal.DBus.Screensaver               (ssSignalDep)
+import Xmobar.Plugins.Screensaver
-import qualified XMonad.Internal.Theme                          as XT
+import Xmobar.Plugins.VPN
 import           Xmobar                                         hiding
    ( iconOffset
    , run
    )
 import           Xmobar.Plugins.Common
 main :: IO ()
 main = getArgs >>= parse
 parse :: [String] -> IO ()
-parse []         = run
+parse [] = run
 parse ["--deps"] = withCache printDeps
 parse ["--test"] = void $ withCache . evalConfig =<< connectDBus
-parse _          = usage
+parse _ = usage
 run :: IO ()
 run = do
@ -84,13 +76,16 @@ printDeps = do
  io $ disconnectDBus db
 usage :: IO ()
-usage = putStrLn $ intercalate "\n"
+usage =
-  [ "xmobar: run greatest taskbar"
+  putStrLn $
-  , "xmobar --deps: print dependencies"
+    intercalate
-  ]
+      "\n"
      [ "xmobar: run greatest taskbar"
      , "xmobar --deps: print dependencies"
      ]
 --------------------------------------------------------------------------------
-- | toplevel configuration
+-- toplevel configuration
 -- | The text font family
 textFont :: Always XT.FontBuilder
@ -102,88 +97,93 @@ textFontOffset = 16
 -- | Attributes for the bar font (size, weight, etc)
 textFontData :: XT.FontData
-textFontData = XT.defFontData { XT.weight = Just XT.Bold, XT.size = Just 11 }
+textFontData = XT.defFontData {XT.weight = Just XT.Bold, XT.size = Just 11}
 -- | The icon font family
 iconFont :: Sometimes XT.FontBuilder
-iconFont = fontSometimes "XMobar Icon Font" "Symbols Nerd Font"
+iconFont =
-  [Package Official "ttf-nerd-fonts-symbols-2048-em"]
+  fontSometimes
    "XMobar Icon Font"
    "Symbols Nerd Font"
    [Package Official "ttf-nerd-fonts-symbols-2048-em"]
 -- | Offsets for the icons in the bar (relative to the text offset)
 iconOffset :: BarFont -> Int
-iconOffset IconSmall  = 0
+iconOffset IconSmall = 0
 iconOffset IconMedium = 1
-iconOffset IconLarge  = 1
+iconOffset IconLarge = 1
 iconOffset IconXLarge = 2
 -- | Sizes (in pixels) for the icon fonts
 iconSize :: BarFont -> Int
-iconSize IconSmall  = 13
+iconSize IconSmall = 13
 iconSize IconMedium = 15
-iconSize IconLarge  = 18
+iconSize IconLarge = 18
 iconSize IconXLarge = 20
 -- | Attributes for icon fonts
 iconFontData :: Int -> XT.FontData
-iconFontData s = XT.defFontData { XT.pixelsize = Just s, XT.size = Nothing }
+iconFontData s = XT.defFontData {XT.pixelsize = Just s, XT.size = Nothing}
 -- | Global configuration
 -- Note that the 'font' and 'textOffset' are assumed to pertain to one (and
 -- only one) text font, and all other fonts are icon fonts. If this assumption
 -- changes the code will need to change significantly
 config :: T.Text -> [T.Text] -> [Int] -> BarRegions -> FilePath -> Config
-config bf ifs ios br confDir = defaultConfig
+config bf ifs ios br confDir =
-  { font = T.unpack bf
+  defaultConfig
-  , additionalFonts = fmap T.unpack ifs
+    { font = T.unpack bf
-  , textOffset = textFontOffset
+    , additionalFonts = fmap T.unpack ifs
-  , textOffsets = ios
+    , textOffset = textFontOffset
-  , bgColor = T.unpack XT.bgColor
+    , textOffsets = ios
-  , fgColor = T.unpack XT.fgColor
+    , bgColor = T.unpack XT.bgColor
-  , position = BottomSize C 100 24
+    , fgColor = T.unpack XT.fgColor
-  , border = NoBorder
+    , position = BottomSize C 100 24
-  , borderColor = T.unpack XT.bordersColor
+    , border = NoBorder
-
+    , borderColor = T.unpack XT.bordersColor
-  , sepChar = T.unpack pSep
+    , sepChar = T.unpack pSep
-  , alignSep = [lSep, rSep]
+    , alignSep = [lSep, rSep]
-  , template = T.unpack $ fmtRegions br
+    , template = T.unpack $ fmtRegions br
-
+    , lowerOnStart = False
-  , lowerOnStart = False
+    , hideOnStart = False
-  , hideOnStart = False
+    , allDesktops = True
-  , allDesktops = True
+    , overrideRedirect = True
-  , overrideRedirect = True
+    , pickBroadest = False
-  , pickBroadest = False
+    , persistent = True
-  , persistent = True
+    , -- store the icons with the xmonad/xmobar stack project
-  -- store the icons with the xmonad/xmobar stack project
+      iconRoot = confDir ++ "/icons"
-  , iconRoot = confDir ++ "/icons"
+    , commands = csRunnable <$> concatRegions br
-
+    }
  , commands = csRunnable <$> concatRegions br
  }
 --------------------------------------------------------------------------------
-- | plugin features
+--  plugin features
 --
 -- some commands depend on the presence of interfaces that can only be
 -- determined at runtime; define these checks here
 getAllCommands :: [Maybe CmdSpec] -> BarRegions
-getAllCommands right = BarRegions
+getAllCommands right =
-  { brLeft = [ CmdSpec
+  BarRegions
-               { csAlias = "UnsafeStdinReader"
+    { brLeft =
-               , csRunnable = Run UnsafeStdinReader
+        [ CmdSpec
-               }
+            { csAlias = "UnsafeStdinReader"
-             ]
+            , csRunnable = Run UnsafeStdinReader
-  , brCenter = []
+            }
-  , brRight = catMaybes right
+        ]
-  }
+    , brCenter = []
    , brRight = catMaybes right
    }
 rightPlugins :: DBusState -> FIO [Maybe CmdSpec]
-rightPlugins db = mapM evalFeature $ allFeatures db
+rightPlugins db =
-  ++ [always' "date indicator" dateCmd]
+  mapM evalFeature $
    allFeatures db
      ++ [always' "date indicator" dateCmd]
  where
    always' n = Right . Always n . Always_ . FallbackAlone
 allFeatures :: DBusState -> [Feature CmdSpec]
-allFeatures DBusState { dbSesClient = ses, dbSysClient = sys } =
+allFeatures DBusState {dbSesClient = ses, dbSysClient = sys} =
  [ Left getWireless
  , Left $ getEthernet sys
  , Left $ getVPN sys
@ -200,8 +200,11 @@ type BarFeature = Sometimes CmdSpec
 -- TODO what if I don't have a wireless card?
 getWireless :: BarFeature
-getWireless = Sometimes "wireless status indicator" xpfWireless
+getWireless =
-  [Subfeature (IORoot wirelessCmd $ Only readWireless) "sysfs path"]
+  Sometimes
    "wireless status indicator"
    xpfWireless
    [Subfeature (IORoot wirelessCmd $ Only readWireless) "sysfs path"]
 getEthernet :: Maybe SysClient -> BarFeature
 getEthernet cl = iconDBus "ethernet status indicator" xpfEthernet root tree
@ -213,32 +216,49 @@ getBattery :: BarFeature
 getBattery = iconIO_ "battery level indicator" xpfBattery root tree
  where
    root useIcon = IORoot_ (batteryCmd useIcon)
-    tree = Only_ $ IOTest_ "Test if battery is present" []
+    tree =
-      $ io $ fmap (Msg LevelError) <$> hasBattery
+      Only_ $
        IOTest_ "Test if battery is present" [] $
          io $
            fmap (Msg LevelError) <$> hasBattery
 getVPN :: Maybe SysClient -> BarFeature
 getVPN cl = iconDBus_ "VPN status indicator" xpfVPN root $ toAnd_ vpnDep test
  where
    root useIcon tree = DBusRoot_ (const $ vpnCmd useIcon) tree cl
-    test = DBusIO $ IOTest_ "Use nmcli to test if VPN is present"
+    test =
-      networkManagerPkgs vpnPresent
+      DBusIO $
        IOTest_
          "Use nmcli to test if VPN is present"
          networkManagerPkgs
          vpnPresent
 getBt :: Maybe SysClient -> BarFeature
 getBt = xmobarDBus "bluetooth status indicator" xpfBluetooth btDep btCmd
 getAlsa :: BarFeature
-getAlsa = iconIO_ "volume level indicator" (const True) root
+getAlsa =
-  $ Only_ $ sysExe [Package Official "alsa-utils"] "alsactl"
+  iconIO_ "volume level indicator" (const True) root $
    Only_ $
      sysExe [Package Official "alsa-utils"] "alsactl"
  where
    root useIcon = IORoot_ (alsaCmd useIcon)
 getBl :: Maybe SesClient -> BarFeature
-getBl = xmobarDBus "Intel backlight indicator" xpfIntelBacklight
+getBl =
-  intelBacklightSignalDep blCmd
+  xmobarDBus
    "Intel backlight indicator"
    xpfIntelBacklight
    intelBacklightSignalDep
    blCmd
 getCk :: Maybe SesClient -> BarFeature
-getCk = xmobarDBus "Clevo keyboard indicator" xpfClevoBacklight
+getCk =
-  clevoKeyboardSignalDep ckCmd
+  xmobarDBus
    "Clevo keyboard indicator"
    xpfClevoBacklight
    clevoKeyboardSignalDep
    ckCmd
 getSs :: Maybe SesClient -> BarFeature
 getSs = xmobarDBus "screensaver indicator" (const True) ssSignalDep ssCmd
@ -249,158 +269,232 @@ getLock = always1 "lock indicator" "icon indicator" root $ lockCmd fontifyAlt
    root = IORoot_ (lockCmd fontifyIcon) $ Only_ iconDependency
 --------------------------------------------------------------------------------
-- | bar feature constructors
+-- bar feature constructors
-xmobarDBus :: SafeClient c => T.Text -> XPQuery -> DBusDependency_ c
+xmobarDBus
-  -> (Fontifier -> CmdSpec) -> Maybe c -> BarFeature
+  :: SafeClient c
  => T.Text
  -> XPQuery
  -> DBusDependency_ c
  -> (Fontifier -> CmdSpec)
  -> Maybe c
  -> BarFeature
 xmobarDBus n q dep cmd cl = iconDBus_ n q root (Only_ dep)
  where
    root useIcon tree = DBusRoot_ (const $ cmd useIcon) tree cl
-iconIO_ :: T.Text -> XPQuery -> (Fontifier -> IOTree_ -> Root CmdSpec)
+iconIO_
-  -> IOTree_ -> BarFeature
+  :: T.Text
  -> XPQuery
  -> (Fontifier -> IOTree_ -> Root CmdSpec)
  -> IOTree_
  -> BarFeature
 iconIO_ = iconSometimes' And_ Only_
-iconDBus :: SafeClient c => T.Text -> XPQuery
+iconDBus
-  -> (Fontifier -> DBusTree c p -> Root CmdSpec) -> DBusTree c p -> BarFeature
+  :: SafeClient c
  => T.Text
  -> XPQuery
  -> (Fontifier -> DBusTree c p -> Root CmdSpec)
  -> DBusTree c p
  -> BarFeature
 iconDBus = iconSometimes' And1 $ Only_ . DBusIO
-iconDBus_ :: SafeClient c => T.Text -> XPQuery
+iconDBus_
-  -> (Fontifier -> DBusTree_ c -> Root CmdSpec) -> DBusTree_ c -> BarFeature
+  :: SafeClient c
  => T.Text
  -> XPQuery
  -> (Fontifier -> DBusTree_ c -> Root CmdSpec)
  -> DBusTree_ c
  -> BarFeature
 iconDBus_ = iconSometimes' And_ $ Only_ . DBusIO
-iconSometimes' :: (t -> t_ -> t) -> (IODependency_ -> t_) -> T.Text -> XPQuery
+iconSometimes'
-  -> (Fontifier -> t -> Root CmdSpec) -> t -> BarFeature
+  :: (t -> t_ -> t)
-iconSometimes' c d n q r t = Sometimes n q
+  -> (IODependency_ -> t_)
-  [ Subfeature icon "icon indicator"
+  -> T.Text
-  , Subfeature text "text indicator"
+  -> XPQuery
-  ]
+  -> (Fontifier -> t -> Root CmdSpec)
  -> t
  -> BarFeature
 iconSometimes' c d n q r t =
  Sometimes
    n
    q
    [ Subfeature icon "icon indicator"
    , Subfeature text "text indicator"
    ]
  where
    icon = r fontifyIcon $ c t $ d iconDependency
    text = r fontifyAlt t
 --------------------------------------------------------------------------------
-- | command specifications
+-- command specifications
 data BarRegions = BarRegions
-  { brLeft   :: [CmdSpec]
+  { brLeft :: [CmdSpec]
  , brCenter :: [CmdSpec]
-  , brRight  :: [CmdSpec]
+  , brRight :: [CmdSpec]
-  } deriving Show
+  }
  deriving (Show)
 data CmdSpec = CmdSpec
-  { csAlias    :: T.Text
+  { csAlias :: T.Text
  , csRunnable :: Runnable
-  } deriving Show
+  }
  deriving (Show)
 concatRegions :: BarRegions -> [CmdSpec]
 concatRegions (BarRegions l c r) = l ++ c ++ r
 wirelessCmd :: T.Text -> CmdSpec
-wirelessCmd iface = CmdSpec
+wirelessCmd iface =
-  { csAlias = T.append iface "wi"
+  CmdSpec
-  , csRunnable = Run $ Wireless (T.unpack iface) args 5
+    { csAlias = T.append iface "wi"
-  }
+    , csRunnable = Run $ Wireless (T.unpack iface) args 5
    }
  where
-    args = fmap T.unpack
+    args =
-      [ "-t", "<qualityipat><essid>"
+      fmap
-      , "--"
+        T.unpack
-      , "--quality-icon-pattern", "<icon=wifi_%%.xpm/>"
+        [ "-t"
-      ]
+        , "<qualityipat><essid>"
        , "--"
        , "--quality-icon-pattern"
        , "<icon=wifi_%%.xpm/>"
        ]
 ethernetCmd :: Fontifier -> T.Text -> CmdSpec
-ethernetCmd fontify iface = CmdSpec
+ethernetCmd fontify iface =
-  { csAlias = iface
+  CmdSpec
-  , csRunnable = Run
+    { csAlias = iface
-    $ Device (iface, fontify IconMedium "\xf0e8" "ETH", colors)
+    , csRunnable =
-  }
+        Run $
          Device (iface, fontify IconMedium "\xf0e8" "ETH", colors)
    }
 batteryCmd :: Fontifier -> CmdSpec
-batteryCmd fontify = CmdSpec
+batteryCmd fontify =
-  { csAlias = "battery"
+  CmdSpec
-  , csRunnable = Run $ Battery args 50
+    { csAlias = "battery"
-  }
+    , csRunnable = Run $ Battery args 50
    }
  where
    fontify' = fontify IconSmall
-    args = fmap T.unpack
+    args =
-      [ "--template", "<acstatus><left>"
+      fmap
-      , "--Low", "10"
+        T.unpack
-      , "--High", "80"
+        [ "--template"
-      , "--low", "red"
+        , "<acstatus><left>"
-      , "--normal", XT.fgColor
+        , "--Low"
-      , "--high", XT.fgColor
+        , "10"
-      , "--"
+        , "--High"
-      , "-P"
+        , "80"
-      , "-o" , fontify' "\xf0e7" "BAT"
+        , "--low"
-      , "-O" , fontify' "\xf1e6" "AC"
+        , "red"
-      , "-i" , fontify' "\xf1e6" "AC"
+        , "--normal"
-      ]
+        , XT.fgColor
        , "--high"
        , XT.fgColor
        , "--"
        , "-P"
        , "-o"
        , fontify' "\xf0e7" "BAT"
        , "-O"
        , fontify' "\xf1e6" "AC"
        , "-i"
        , fontify' "\xf1e6" "AC"
        ]
 vpnCmd :: Fontifier -> CmdSpec
-vpnCmd fontify = CmdSpec
+vpnCmd fontify =
-  { csAlias = vpnAlias
+  CmdSpec
-  , csRunnable = Run $ VPN (fontify IconMedium "\xf023" "VPN", colors)
+    { csAlias = vpnAlias
-  }
+    , csRunnable = Run $ VPN (fontify IconMedium "\xf023" "VPN", colors)
    }
 btCmd :: Fontifier -> CmdSpec
-btCmd fontify = CmdSpec
+btCmd fontify =
-  { csAlias = btAlias
+  CmdSpec
-  , csRunnable = Run
+    { csAlias = btAlias
-    $ Bluetooth (fontify' "\xf5b0" "+", fontify' "\xf5ae" "-") colors
+    , csRunnable =
-  }
+        Run $
          Bluetooth (fontify' "\xf5b0" "+", fontify' "\xf5ae" "-") colors
    }
  where
    fontify' i = fontify IconLarge i . T.append "BT"
 alsaCmd :: Fontifier -> CmdSpec
-alsaCmd fontify = CmdSpec
+alsaCmd fontify =
-  { csAlias = "alsa:default:Master"
+  CmdSpec
-  , csRunnable = Run
+    { csAlias = "alsa:default:Master"
-    $ Alsa "default" "Master"
+    , csRunnable =
-    $ fmap T.unpack
+        Run $
-    [ "-t", "<status><volume>%"
+          Alsa "default" "Master" $
-    , "--"
+            fmap
-    , "-O", fontify' "\xf028" "+"
+              T.unpack
-    , "-o", T.append (fontify' "\xf026" "-") " "
+              [ "-t"
-    , "-c", XT.fgColor
+              , "<status><volume>%"
-    , "-C", XT.fgColor
+              , "--"
-    ]
+              , "-O"
-  }
+              , fontify' "\xf028" "+"
              , "-o"
              , T.append (fontify' "\xf026" "-") " "
              , "-c"
              , XT.fgColor
              , "-C"
              , XT.fgColor
              ]
    }
  where
    fontify' i = fontify IconSmall i . T.append "VOL"
 blCmd :: Fontifier -> CmdSpec
-blCmd fontify = CmdSpec
+blCmd fontify =
-  { csAlias = blAlias
+  CmdSpec
-  , csRunnable = Run $ IntelBacklight $ fontify IconSmall "\xf185" "BL: "
+    { csAlias = blAlias
-  }
+    , csRunnable = Run $ IntelBacklight $ fontify IconSmall "\xf185" "BL: "
    }
 ckCmd :: Fontifier -> CmdSpec
-ckCmd fontify = CmdSpec
+ckCmd fontify =
-  { csAlias = ckAlias
+  CmdSpec
-  , csRunnable = Run $ ClevoKeyboard $ fontify IconSmall "\xf40b" "KB: "
+    { csAlias = ckAlias
-  }
+    , csRunnable = Run $ ClevoKeyboard $ fontify IconSmall "\xf40b" "KB: "
    }
 ssCmd :: Fontifier -> CmdSpec
-ssCmd fontify = CmdSpec
+ssCmd fontify =
-  { csAlias = ssAlias
+  CmdSpec
-  , csRunnable = Run $ Screensaver (fontify IconSmall "\xf254" "SS", colors)
+    { csAlias = ssAlias
-  }
+    , csRunnable = Run $ Screensaver (fontify IconSmall "\xf254" "SS", colors)
    }
 lockCmd :: Fontifier -> CmdSpec
-lockCmd fontify = CmdSpec
+lockCmd fontify =
-  { csAlias = "locks"
+  CmdSpec
-  , csRunnable = Run
+    { csAlias = "locks"
-    $ Locks
+    , csRunnable =
-    $ fmap T.unpack
+        Run $
-    [ "-N", numIcon
+          Locks $
-    , "-n", disabledColor numIcon
+            fmap
-    , "-C", capIcon
+              T.unpack
-    , "-c", disabledColor capIcon
+              [ "-N"
-    , "-s", ""
+              , numIcon
-    , "-S", ""
+              , "-n"
-    , "-d", " "
+              , disabledColor numIcon
-    ]
+              , "-C"
-  }
+              , capIcon
              , "-c"
              , disabledColor capIcon
              , "-s"
              , ""
              , "-S"
              , ""
              , "-d"
              , " "
              ]
    }
  where
    numIcon = fontify' "\xf8a5" "N"
    capIcon = fontify' "\xf657" "C"
@ -408,33 +502,37 @@ lockCmd fontify = CmdSpec
    disabledColor = xmobarFGColor XT.backdropFgColor
 dateCmd :: CmdSpec
-dateCmd = CmdSpec
+dateCmd =
-  { csAlias = "date"
+  CmdSpec
-  , csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
+    { csAlias = "date"
-  }
+    , csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
    }
 --------------------------------------------------------------------------------
-- | low-level testing functions
+-- low-level testing functions
 vpnPresent :: FIO (Maybe Msg)
 vpnPresent = do
  res <- proc "nmcli" args readProcess
  return $ case res of
-    (ExitSuccess, out, _) | "vpn" `elem` BL.split 10 out -> Nothing
+    (ExitSuccess, out, _)
-                          | otherwise -> Just $ Msg LevelError "vpn not found"
+      | "vpn" `elem` BL.split 10 out -> Nothing
-    (ExitFailure c, _, err) -> Just $ Msg LevelError
+      | otherwise -> Just $ Msg LevelError "vpn not found"
-                               $ T.concat
+    (ExitFailure c, _, err) ->
-                               ["vpn search exited with code "
+      Just $
-                               , T.pack $ show c
+        Msg LevelError $
-                               , ": "
+          T.concat
-                               , T.decodeUtf8With T.lenientDecode
+            [ "vpn search exited with code "
-                                 $ BL.toStrict err
+            , T.pack $ show c
-                               ]
+            , ": "
            , T.decodeUtf8With T.lenientDecode $
                BL.toStrict err
            ]
  where
    args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
 --------------------------------------------------------------------------------
-- | text font
+-- text font
 --
 -- ASSUME there is only one text font for this entire configuration. This
 -- will correspond to the first font/offset parameters in the config record.
@ -445,17 +543,20 @@ getTextFont = do
  return $ fb textFontData
 --------------------------------------------------------------------------------
-- | icon fonts
+-- icon fonts
 getIconFonts :: FIO ([T.Text], [Int])
 getIconFonts = do
  fb <- evalSometimes iconFont
  return $ maybe ([], []) apply fb
  where
-    apply fb = unzip $ (\i -> (iconString fb i, iconOffset i + textFontOffset))
+    apply fb =
-      <$> iconFonts
+      unzip $
        (\i -> (iconString fb i, iconOffset i + textFontOffset))
          <$> iconFonts
-data BarFont = IconSmall
+data BarFont
  = IconSmall
  | IconMedium
  | IconLarge
  | IconXLarge
@ -483,10 +584,10 @@ fontifyIcon :: Fontifier
 fontifyIcon f i _ = fontifyText f i
 --------------------------------------------------------------------------------
-- | various formatting things
+-- various formatting things
 colors :: Colors
-colors = Colors { colorsOn = XT.fgColor, colorsOff = XT.backdropFgColor }
+colors = Colors {colorsOn = XT.fgColor, colorsOff = XT.backdropFgColor}
 sep :: T.Text
 sep = xmobarFGColor XT.backdropFgColor " : "
@ -503,8 +604,9 @@ pSep = "%"
 fmtSpecs :: [CmdSpec] -> T.Text
 fmtSpecs = T.intercalate sep . fmap go
  where
-    go CmdSpec { csAlias = a } = T.concat [pSep, a, pSep]
+    go CmdSpec {csAlias = a} = T.concat [pSep, a, pSep]
 fmtRegions :: BarRegions -> T.Text
-fmtRegions BarRegions { brLeft = l, brCenter = c, brRight = r } = T.concat
+fmtRegions BarRegions {brLeft = l, brCenter = c, brRight = r} =
-  [fmtSpecs l, T.singleton lSep, fmtSpecs c, T.singleton rSep, fmtSpecs r]
+  T.concat
    [fmtSpecs l, T.singleton lSep, fmtSpecs c, T.singleton rSep, fmtSpecs r]
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
--- a/fourmolu.yaml
+++ b/fourmolu.yaml
@ -0,0 +1,14 @@
 indentation: 2
 function-arrows: leading
 comma-style: leading
 import-export-style: leading
 indent-wheres: true
 record-brace-space: true
 newlines-between-decls: 1
 haddock-style: single-line
 haddock-style-module:
 let-style: inline
 in-style: right-align
 respectful: false
 fixities: []
 unicode: never
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@ -1,15 +1,15 @@
 --------------------------------------------------------------------------------
-- | Common internal DBus functions
+-- Common internal DBus functions
 module Data.Internal.DBus
-  ( SafeClient(..)
+  ( SafeClient (..)
-  , SysClient(..)
+  , SysClient (..)
-  , SesClient(..)
+  , SesClient (..)
  , addMatchCallback
  , matchProperty
  , matchPropertyFull
  , matchPropertyChanged
-  , SignalMatch(..)
+  , SignalMatch (..)
  , SignalCallback
  , MethodBody
  , withSignalMatch
@ -25,22 +25,20 @@ module Data.Internal.DBus
  , addInterfaceRemovedListener
  , fromSingletonVariant
  , bodyToMaybe
-  ) where
+  )
 where
-import           Control.Exception
+import Control.Exception
-import           Control.Monad
+import Control.Monad
-
+import DBus
-import           Data.Bifunctor
+import DBus.Client
-import qualified Data.Map.Strict   as M
+import Data.Bifunctor
-import           Data.Maybe
+import qualified Data.Map.Strict as M
-
+import Data.Maybe
-import qualified RIO.Text          as T
+import qualified RIO.Text as T
 import           DBus
 import           DBus.Client
 --------------------------------------------------------------------------------
-- | Type-safe client
+-- Type-safe client
 class SafeClient c where
  toClient :: c -> Client
@ -82,28 +80,37 @@ getDBusClient' :: Bool -> IO (Maybe Client)
 getDBusClient' sys = do
  res <- try $ if sys then connectSystem else connectSession
  case res of
-    Left e  -> putStrLn (clientErrorMessage e) >> return Nothing
+    Left e -> putStrLn (clientErrorMessage e) >> return Nothing
    Right c -> return $ Just c
 --------------------------------------------------------------------------------
-- | Methods
+-- Methods
 type MethodBody = Either T.Text [Variant]
 callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody
-callMethod' cl = fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
+callMethod' cl =
-  . call (toClient cl)
+  fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
    . call (toClient cl)
-callMethod :: SafeClient c => c -> BusName -> ObjectPath -> InterfaceName
+callMethod
-  -> MemberName -> IO MethodBody
+  :: SafeClient c
  => c
  -> BusName
  -> ObjectPath
  -> InterfaceName
  -> MemberName
  -> IO MethodBody
 callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
 methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
-methodCallBus b p i m = (methodCall p i m)
+methodCallBus b p i m =
-    { methodCallDestination = Just b }
+  (methodCall p i m)
    { methodCallDestination = Just b
    }
 --------------------------------------------------------------------------------
-- | Bus names
+-- Bus names
 dbusInterface :: InterfaceName
 dbusInterface = interfaceName_ "org.freedesktop.DBus"
@ -111,12 +118,14 @@ dbusInterface = interfaceName_ "org.freedesktop.DBus"
 callGetNameOwner :: SafeClient c => c -> BusName -> IO (Maybe BusName)
 callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
  where
-    mc = (methodCallBus dbusName dbusPath dbusInterface mem)
+    mc =
-      { methodCallBody = [toVariant name] }
+      (methodCallBus dbusName dbusPath dbusInterface mem)
        { methodCallBody = [toVariant name]
        }
    mem = memberName_ "GetNameOwner"
 --------------------------------------------------------------------------------
-- | Variant parsing
+-- Variant parsing
 fromSingletonVariant :: IsVariant a => [Variant] -> Maybe a
 fromSingletonVariant = fromVariant <=< listToMaybe
@ -125,30 +134,45 @@ bodyToMaybe :: IsVariant a => MethodBody -> Maybe a
 bodyToMaybe = either (const Nothing) fromSingletonVariant
 --------------------------------------------------------------------------------
-- | Signals
+-- Signals
 type SignalCallback = [Variant] -> IO ()
-addMatchCallback :: SafeClient c => MatchRule -> SignalCallback -> c
+addMatchCallback
  :: SafeClient c
  => MatchRule
  -> SignalCallback
  -> c
  -> IO SignalHandler
 addMatchCallback rule cb cl = addMatch (toClient cl) rule $ cb . signalBody
-matchSignal :: Maybe BusName -> Maybe ObjectPath -> Maybe InterfaceName
+matchSignal
-  -> Maybe MemberName -> MatchRule
+  :: Maybe BusName
-matchSignal b p i m = matchAny
+  -> Maybe ObjectPath
-  { matchPath = p
+  -> Maybe InterfaceName
-  , matchSender = b
+  -> Maybe MemberName
-  , matchInterface = i
+  -> MatchRule
-  , matchMember = m
+matchSignal b p i m =
-  }
+  matchAny
    { matchPath = p
    , matchSender = b
    , matchInterface = i
    , matchMember = m
    }
-matchSignalFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
+matchSignalFull
-  -> Maybe InterfaceName -> Maybe MemberName -> IO (Maybe MatchRule)
+  :: SafeClient c
  => c
  -> BusName
  -> Maybe ObjectPath
  -> Maybe InterfaceName
  -> Maybe MemberName
  -> IO (Maybe MatchRule)
 matchSignalFull client b p i m =
  fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
 --------------------------------------------------------------------------------
-- | Properties
+-- Properties
 propertyInterface :: InterfaceName
 propertyInterface = interfaceName_ "org.freedesktop.DBus.Properties"
@ -156,16 +180,28 @@ propertyInterface = interfaceName_ "org.freedesktop.DBus.Properties"
 propertySignal :: MemberName
 propertySignal = memberName_ "PropertiesChanged"
-callPropertyGet :: SafeClient c => BusName -> ObjectPath -> InterfaceName
+callPropertyGet
-  -> MemberName -> c -> IO [Variant]
+  :: SafeClient c
-callPropertyGet bus path iface property cl = fmap (either (const []) (:[]))
+  => BusName
-  $ getProperty (toClient cl) $ methodCallBus bus path iface property
+  -> ObjectPath
  -> InterfaceName
  -> MemberName
  -> c
  -> IO [Variant]
 callPropertyGet bus path iface property cl =
  fmap (either (const []) (: [])) $
    getProperty (toClient cl) $
      methodCallBus bus path iface property
 matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
 matchProperty b p =
  matchSignal b p (Just propertyInterface) (Just propertySignal)
-matchPropertyFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
+matchPropertyFull
  :: SafeClient c
  => c
  -> BusName
  -> Maybe ObjectPath
  -> IO (Maybe MatchRule)
 matchPropertyFull cl b p =
  matchSignalFull cl b p (Just propertyInterface) (Just propertySignal)
@ -174,25 +210,30 @@ data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show)
 withSignalMatch :: (Maybe a -> IO ()) -> SignalMatch a -> IO ()
 withSignalMatch f (Match x) = f (Just x)
-withSignalMatch f Failure   = f Nothing
+withSignalMatch f Failure = f Nothing
-withSignalMatch _ NoMatch   = return ()
+withSignalMatch _ NoMatch = return ()
-matchPropertyChanged :: IsVariant a => InterfaceName -> T.Text -> [Variant]
+matchPropertyChanged
  :: IsVariant a
  => InterfaceName
  -> T.Text
  -> [Variant]
  -> SignalMatch a
 matchPropertyChanged iface property [i, body, _] =
  let i' = (fromVariant i :: Maybe T.Text)
-      b = toMap body in
+      b = toMap body
-    case (i', b) of
+   in case (i', b) of
-      (Just i'', Just b') -> if i'' == T.pack (formatInterfaceName iface) then
+        (Just i'', Just b') ->
-        maybe NoMatch Match $ fromVariant =<< M.lookup property b'
+          if i'' == T.pack (formatInterfaceName iface)
-        else NoMatch
+            then maybe NoMatch Match $ fromVariant =<< M.lookup property b'
-      _                   -> Failure
+            else NoMatch
        _ -> Failure
  where
    toMap v = fromVariant v :: Maybe (M.Map T.Text Variant)
 matchPropertyChanged _ _ _ = Failure
 --------------------------------------------------------------------------------
-- | Object Manager
+-- Object Manager
 type ObjectTree = M.Map ObjectPath (M.Map T.Text (M.Map T.Text Variant))
@ -208,24 +249,44 @@ omInterfacesAdded = memberName_ "InterfacesAdded"
 omInterfacesRemoved :: MemberName
 omInterfacesRemoved = memberName_ "InterfacesRemoved"
-callGetManagedObjects :: SafeClient c => c -> BusName -> ObjectPath
+callGetManagedObjects
  :: SafeClient c
  => c
  -> BusName
  -> ObjectPath
  -> IO ObjectTree
 callGetManagedObjects cl bus path =
  either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
-  <$> callMethod cl bus path omInterface getManagedObjects
+    <$> callMethod cl bus path omInterface getManagedObjects
-addInterfaceChangedListener :: SafeClient c => BusName -> MemberName
+addInterfaceChangedListener
-  -> ObjectPath -> SignalCallback -> c -> IO (Maybe SignalHandler)
+  :: SafeClient c
  => BusName
  -> MemberName
  -> ObjectPath
  -> SignalCallback
  -> c
  -> IO (Maybe SignalHandler)
 addInterfaceChangedListener bus prop path sc cl = do
  rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
  forM rule $ \r -> addMatchCallback r sc cl
-addInterfaceAddedListener :: SafeClient c => BusName -> ObjectPath
+addInterfaceAddedListener
-  -> SignalCallback -> c -> IO (Maybe SignalHandler)
+  :: SafeClient c
  => BusName
  -> ObjectPath
  -> SignalCallback
  -> c
  -> IO (Maybe SignalHandler)
 addInterfaceAddedListener bus =
  addInterfaceChangedListener bus omInterfacesAdded
-addInterfaceRemovedListener :: SafeClient c => BusName -> ObjectPath
+addInterfaceRemovedListener
-  -> SignalCallback -> c -> IO (Maybe SignalHandler)
+  :: SafeClient c
  => BusName
  -> ObjectPath
  -> SignalCallback
  -> c
  -> IO (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
  addInterfaceChangedListener bus omInterfacesRemoved
--- a/lib/Data/Internal/Dependency.hs
+++ b/lib/Data/Internal/Dependency.hs
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Dmenu (Rofi) Commands
+-- Dmenu (Rofi) Commands
 module XMonad.Internal.Command.DMenu
  ( runCmdMenu
@ -15,32 +15,28 @@ module XMonad.Internal.Command.DMenu
  , runBTMenu
  , runShowKeys
  , runAutorandrMenu
-  ) where
+  )
 where
-import           Data.Internal.DBus
+import DBus
-import           Data.Internal.Dependency
+import Data.Internal.DBus
-
+import Data.Internal.Dependency
-import           DBus
+import Graphics.X11.Types
-
+import qualified RIO.Text as T
-import           Graphics.X11.Types
+import System.Directory
-
+  ( XdgDirectory (..)
-import qualified RIO.Text                        as T
+  , getXdgDirectory
-
+  )
-import           System.Directory
+import System.IO
-    ( XdgDirectory (..)
+import XMonad.Core hiding (spawn)
-    , getXdgDirectory
+import XMonad.Internal.Command.Desktop
-    )
+import XMonad.Internal.DBus.Common
-import           System.IO
+import XMonad.Internal.Notify
-
+import XMonad.Internal.Shell
-import           XMonad.Core                     hiding (spawn)
+import XMonad.Util.NamedActions
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Notify
 import           XMonad.Internal.Shell
 import           XMonad.Util.NamedActions
 --------------------------------------------------------------------------------
-- | DMenu executables
+-- DMenu executables
 myDmenuCmd :: FilePath
 myDmenuCmd = "rofi"
@ -67,7 +63,7 @@ myClipboardManager :: FilePath
 myClipboardManager = "greenclip"
 --------------------------------------------------------------------------------
-- | Packages
+-- Packages
 dmenuPkgs :: [Fulfillment]
 dmenuPkgs = [Package Official "rofi"]
@ -76,7 +72,7 @@ clipboardPkgs :: [Fulfillment]
 clipboardPkgs = [Package AUR "rofi-greenclip"]
 --------------------------------------------------------------------------------
-- | Other internal functions
+-- Other internal functions
 spawnDmenuCmd :: T.Text -> [T.Text] -> SometimesX
 spawnDmenuCmd n =
@ -98,7 +94,7 @@ dmenuDep :: IODependency_
 dmenuDep = sysExe dmenuPkgs myDmenuCmd
 --------------------------------------------------------------------------------
-- | Exported Commands
+-- Exported Commands
 -- TODO test that veracrypt and friends are installed
 runDevMenu :: SometimesX
@ -107,28 +103,38 @@ runDevMenu = sometimesIO_ "device manager" "rofi devices" t x
    t = dmenuTree $ Only_ (localExe [] myDmenuDevices)
    x = do
      c <- io $ getXdgDirectory XdgConfig "rofi/devices.dhall"
-      spawnCmd myDmenuDevices
+      spawnCmd myDmenuDevices $
-        $ ["-c", T.pack c]
+        ["-c", T.pack c]
-        ++ "--" : themeArgs "#999933"
+          ++ "--"
-        ++ myDmenuMatchingArgs
+          : themeArgs "#999933"
          ++ myDmenuMatchingArgs
 -- TODO test that bluetooth interface exists
 runBTMenu :: SometimesX
-runBTMenu = Sometimes "bluetooth selector" xpfBluetooth
+runBTMenu =
-  [Subfeature (IORoot_ cmd tree) "rofi bluetooth"]
+  Sometimes
    "bluetooth selector"
    xpfBluetooth
    [Subfeature (IORoot_ cmd tree) "rofi bluetooth"]
  where
-    cmd = spawnCmd myDmenuBluetooth $ "-c":themeArgs "#0044bb"
+    cmd = spawnCmd myDmenuBluetooth $ "-c" : themeArgs "#0044bb"
    tree = dmenuTree $ Only_ $ sysExe [] myDmenuBluetooth
 runVPNMenu :: SometimesX
-runVPNMenu = Sometimes "VPN selector" xpfVPN
+runVPNMenu =
-  [Subfeature (IORoot_ cmd tree) "rofi VPN"]
+  Sometimes
    "VPN selector"
    xpfVPN
    [Subfeature (IORoot_ cmd tree) "rofi VPN"]
  where
-    cmd = spawnCmd myDmenuVPN
+    cmd =
-      $ ["-c"] ++ themeArgs "#007766" ++ myDmenuMatchingArgs
+      spawnCmd myDmenuVPN $
-    tree = dmenuTree $ toAnd_ (localExe [] myDmenuVPN)
+        ["-c"] ++ themeArgs "#007766" ++ myDmenuMatchingArgs
-      $ socketExists "expressVPN" []
+    tree =
-      $ return "/var/lib/expressvpn/expressvpnd.socket"
+      dmenuTree $
        toAnd_ (localExe [] myDmenuVPN) $
          socketExists "expressVPN" [] $
            return "/var/lib/expressvpn/expressvpnd.socket"
 runCmdMenu :: SometimesX
 runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
@ -140,15 +146,20 @@ runWinMenu :: SometimesX
 runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]
 runNetMenu :: Maybe SysClient -> SometimesX
-runNetMenu cl = Sometimes "network control menu" enabled
+runNetMenu cl =
-  [Subfeature root "network control menu"]
+  Sometimes
    "network control menu"
    enabled
    [Subfeature root "network control menu"]
  where
    enabled f = xpfEthernet f || xpfWireless f || xpfVPN f
    root = DBusRoot_ cmd tree cl
    cmd _ = spawnCmd myDmenuNetworks $ themeArgs "#ff3333"
-    tree = And_ (Only_ $ Bus networkManagerPkgs networkManagerBus)
+    tree =
-      $ toAnd_ (DBusIO dmenuDep) $ DBusIO
+      And_ (Only_ $ Bus networkManagerPkgs networkManagerBus) $
-      $ sysExe [Package AUR "networkmanager-dmenu-git"] myDmenuNetworks
+        toAnd_ (DBusIO dmenuDep) $
          DBusIO $
            sysExe [Package AUR "networkmanager-dmenu-git"] myDmenuNetworks
 runAutorandrMenu :: SometimesX
 runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
@ -157,47 +168,63 @@ runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
    tree = dmenuTree $ Only_ $ localExe [] myDmenuMonitors
 --------------------------------------------------------------------------------
-- | Password manager
+-- Password manager
 runBwMenu :: Maybe SesClient -> SometimesX
 runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd
  where
-    cmd _ = spawnCmd myDmenuPasswords
+    cmd _ =
-      $ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
+      spawnCmd myDmenuPasswords $
-    tree = And_ (Only_ $ Bus [] $ busName_ "org.rofi.bitwarden")
+        ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
-      $ toAnd_ (DBusIO dmenuDep) (DBusIO $ localExe [] myDmenuPasswords)
+    tree =
      And_ (Only_ $ Bus [] $ busName_ "org.rofi.bitwarden") $
        toAnd_ (DBusIO dmenuDep) (DBusIO $ localExe [] myDmenuPasswords)
 --------------------------------------------------------------------------------
-- | Clipboard
+-- Clipboard
 runClipMenu :: SometimesX
 runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
  where
    act = spawnCmd myDmenuCmd args
-    tree = listToAnds dmenuDep [ sysExe clipboardPkgs myClipboardManager
+    tree =
-                               , process [] $ T.pack myClipboardManager
+      listToAnds
-                               ]
+        dmenuDep
-    args = [ "-modi", "\"clipboard:greenclip print\""
+        [ sysExe clipboardPkgs myClipboardManager
-           , "-show", "clipboard"
+        , process [] $ T.pack myClipboardManager
-           , "-run-command", "'{cmd}'"
+        ]
-           ] ++ themeArgs "#00c44e"
+    args =
      [ "-modi"
      , "\"clipboard:greenclip print\""
      , "-show"
      , "clipboard"
      , "-run-command"
      , "'{cmd}'"
      ]
        ++ themeArgs "#00c44e"
 --------------------------------------------------------------------------------
-- | Shortcut menu
+-- Shortcut menu
 runShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
-runShowKeys = Always "keyboard menu" $ Option showKeysDMenu $ Always_
+runShowKeys =
-  $ FallbackAlone fallback
+  Always "keyboard menu" $
    Option showKeysDMenu $
      Always_ $
        FallbackAlone fallback
  where
    -- TODO this should technically depend on dunst
-    fallback = const $ spawnNotify
+    fallback =
-      $ defNoteError { body = Just $ Text "could not display keymap" }
+      const $
        spawnNotify $
          defNoteError {body = Just $ Text "could not display keymap"}
 showKeysDMenu :: SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> X ())
-showKeysDMenu = Subfeature
+showKeysDMenu =
-  { sfName = "keyboard shortcut menu"
+  Subfeature
-  , sfData = IORoot_ showKeys $ Only_ dmenuDep
+    { sfName = "keyboard shortcut menu"
-  }
+    , sfData = IORoot_ showKeys $ Only_ dmenuDep
    }
 showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
 showKeys kbs = do
@ -205,5 +232,8 @@ showKeys kbs = do
  io $ hPutStr h $ unlines $ showKm kbs
  io $ hClose h
  where
-    cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
+    cmd =
-      ++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs
+      fmtCmd myDmenuCmd $
        ["-dmenu", "-p", "commands"]
          ++ themeArgs "#7f66ff"
          ++ myDmenuMatchingArgs
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@ -1,12 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | General commands
+-- General commands
 module XMonad.Internal.Command.Desktop
  ( myTerm
  , playSound
  -- commands
  , runTerm
  , runTMux
@ -33,37 +32,32 @@ module XMonad.Internal.Command.Desktop
  , runNotificationCloseAll
  , runNotificationHistory
  , runNotificationContext
  -- daemons
  , runNetAppDaemon
  -- packages
  , networkManagerPkgs
-  ) where
+  )
 where
-import           Data.Internal.DBus
+import DBus
-import           Data.Internal.Dependency
+import Data.Internal.DBus
-
+import Data.Internal.Dependency
-import           DBus
+import RIO
-
+import RIO.FilePath
-import           RIO
+import qualified RIO.Process as P
-import           RIO.FilePath
+import qualified RIO.Text as T
-import qualified RIO.Process                 as P
+import System.Directory
-import qualified RIO.Text                    as T
+import System.Environment
-
+import System.Posix.User
-import           System.Directory
+import XMonad.Actions.Volume
-import           System.Environment
+import XMonad.Core hiding (spawn)
-import           System.Posix.User
+import XMonad.Internal.DBus.Common
-
+import XMonad.Internal.Notify
-import           XMonad.Actions.Volume
+import XMonad.Internal.Shell as S
-import           XMonad.Core                 hiding (spawn)
+import XMonad.Operations
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Notify
 import           XMonad.Internal.Shell       as S
 import           XMonad.Operations
 --------------------------------------------------------------------------------
-- | My Executables
+-- My Executables
 myTerm :: FilePath
 myTerm = "urxvt"
@ -96,12 +90,13 @@ myNotificationCtrl :: FilePath
 myNotificationCtrl = "dunstctl"
 --------------------------------------------------------------------------------
-- | Packages
+-- Packages
 myTermPkgs :: [Fulfillment]
-myTermPkgs = [ Package Official "rxvt-unicode"
+myTermPkgs =
-             , Package Official "urxvt-perls"
+  [ Package Official "rxvt-unicode"
-             ]
+  , Package Official "urxvt-perls"
  ]
 myEditorPkgs :: [Fulfillment]
 myEditorPkgs = [Package Official "emacs-nativecomp"]
@ -116,13 +111,13 @@ networkManagerPkgs :: [Fulfillment]
 networkManagerPkgs = [Package Official "networkmanager"]
 --------------------------------------------------------------------------------
-- | Misc constants
+-- Misc constants
 volumeChangeSound :: FilePath
 volumeChangeSound = "smb_fireball.wav"
 --------------------------------------------------------------------------------
-- | Some nice apps
+-- Some nice apps
 runTerm :: SometimesX
 runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm
@ -130,12 +125,14 @@ runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm
 runTMux :: SometimesX
 runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
  where
-    deps = listToAnds (socketExists "tmux" [] socketName)
+    deps =
-      $ fmap (sysExe myTermPkgs) [myTerm, "tmux", "bash"]
+      listToAnds (socketExists "tmux" [] socketName) $
-    act = S.spawn
+        fmap (sysExe myTermPkgs) [myTerm, "tmux", "bash"]
-      $ fmtCmd "tmux" ["has-session"]
+    act =
-      #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
+      S.spawn $
-      #!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
+        fmtCmd "tmux" ["has-session"]
          #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
          #!|| fmtNotifyCmd defNoteError {body = Just $ Text msg}
    c = "exec tmux attach-session -d"
    msg = "could not connect to tmux session"
    socketName = do
@ -150,28 +147,46 @@ runCalc = sometimesIO_ "calculator" "bc" deps act
    act = spawnCmd myTerm ["-e", T.pack myCalc, "-l"]
 runBrowser :: SometimesX
-runBrowser = sometimesExe "web browser" "brave" [Package AUR "brave-bin"]
+runBrowser =
-  False myBrowser
+  sometimesExe
    "web browser"
    "brave"
    [Package AUR "brave-bin"]
    False
    myBrowser
 runEditor :: SometimesX
 runEditor = sometimesIO_ "text editor" "emacs" tree cmd
  where
-    cmd = spawnCmd myEditor
+    cmd =
-      ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
+      spawnCmd
        myEditor
        ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
    -- NOTE 1: we could test if the emacs socket exists, but it won't come up
    -- before xmonad starts, so just check to see if the process has started
    tree = toAnd_ (sysExe myEditorPkgs myEditor) $ process [] $ T.pack myEditorServer
 runFileManager :: SometimesX
-runFileManager = sometimesExe "file browser" "pcmanfm" [Package Official "pcmanfm"]
+runFileManager =
-  True "pcmanfm"
+  sometimesExe
    "file browser"
    "pcmanfm"
    [Package Official "pcmanfm"]
    True
    "pcmanfm"
 --------------------------------------------------------------------------------
-- | Multimedia Commands
+-- Multimedia Commands
 runMultimediaIfInstalled :: T.Text -> T.Text -> SometimesX
-runMultimediaIfInstalled n cmd = sometimesExeArgs (T.append n " multimedia control")
+runMultimediaIfInstalled n cmd =
-  "playerctl" [Package Official "playerctl"] True myMultimediaCtl [cmd]
+  sometimesExeArgs
    (T.append n " multimedia control")
    "playerctl"
    [Package Official "playerctl"]
    True
    myMultimediaCtl
    [cmd]
 runTogglePlay :: SometimesX
 runTogglePlay = runMultimediaIfInstalled "play/pause" "play-pause"
@ -186,7 +201,7 @@ runStopPlay :: SometimesX
 runStopPlay = runMultimediaIfInstalled "stop playback" "stop"
 --------------------------------------------------------------------------------
-- | Volume Commands
+-- Volume Commands
 soundDir :: FilePath
 soundDir = "sound"
@ -200,8 +215,8 @@ playSound file = do
 featureSound :: T.Text -> FilePath -> X () -> X () -> SometimesX
 featureSound n file pre post =
-  sometimesIO_ (T.unwords ["volume", n, " control"]) "paplay" tree
+  sometimesIO_ (T.unwords ["volume", n, " control"]) "paplay" tree $
-  $ pre >> playSound file >> post
+    pre >> playSound file >> post
  where
    -- ASSUME pulseaudio pulls in libpulse as a dep; pulseaudio itself is needed
    -- to play sound (duh) but libpulse is the package with the paplay binary
@ -217,16 +232,18 @@ runVolumeMute :: SometimesX
 runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return ()
 --------------------------------------------------------------------------------
-- | Notification control
+-- Notification control
 runNotificationCmd :: T.Text -> T.Text -> Maybe SesClient -> SometimesX
 runNotificationCmd n arg cl =
  sometimesDBus cl (T.unwords [n, "control"]) "dunstctl" tree cmd
  where
    cmd _ = spawnCmd myNotificationCtrl [arg]
-    tree = toAnd_ (DBusIO $ sysExe notifyPkgs myNotificationCtrl)
+    tree =
-      $ Endpoint [] notifyBus notifyPath (interfaceName_ "org.dunstproject.cmd0")
+      toAnd_ (DBusIO $ sysExe notifyPkgs myNotificationCtrl) $
-      $ Method_ $ memberName_ "NotificationAction"
+        Endpoint [] notifyBus notifyPath (interfaceName_ "org.dunstproject.cmd0") $
          Method_ $
            memberName_ "NotificationAction"
 runNotificationClose :: Maybe SesClient -> SometimesX
 runNotificationClose = runNotificationCmd "close notification" "close"
@ -244,47 +261,61 @@ runNotificationContext =
  runNotificationCmd "open notification context" "context"
 --------------------------------------------------------------------------------
-- | System commands
+-- System commands
 -- this is required for some vpn's to work properly with network-manager
 runNetAppDaemon :: Maybe SysClient -> Sometimes (FIO (P.Process () () ()))
-runNetAppDaemon cl = Sometimes "network applet" xpfVPN
+runNetAppDaemon cl =
-  [Subfeature (DBusRoot_ cmd tree cl) "NM-applet"]
+  Sometimes
    "network applet"
    xpfVPN
    [Subfeature (DBusRoot_ cmd tree cl) "NM-applet"]
  where
    tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
    app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
    cmd _ = P.proc "nm-applet" [] (P.startProcess . P.setCreateGroup True)
 runToggleBluetooth :: Maybe SysClient -> SometimesX
-runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth
+runToggleBluetooth cl =
-  [Subfeature (DBusRoot_ cmd tree cl) "bluetoothctl"]
+  Sometimes
    "bluetooth toggle"
    xpfBluetooth
    [Subfeature (DBusRoot_ cmd tree cl) "bluetoothctl"]
  where
    tree = And_ (Only_ $ DBusIO $ sysExe bluetoothPkgs myBluetooth) (Only_ $ Bus [] btBus)
-    cmd _ = S.spawn
+    cmd _ =
-      $ fmtCmd myBluetooth ["show"]
+      S.spawn $
-      #!| "grep -q \"Powered: no\""
+        fmtCmd myBluetooth ["show"]
-      #!&& "a=on"
+          #!| "grep -q \"Powered: no\""
-      #!|| "a=off"
+          #!&& "a=on"
-      #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
+          #!|| "a=off"
-      #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
+          #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "bluetooth powered $a"}
 runToggleEthernet :: SometimesX
-runToggleEthernet = Sometimes "ethernet toggle" xpfEthernet
+runToggleEthernet =
-  [Subfeature root "nmcli"]
+  Sometimes
    "ethernet toggle"
    xpfEthernet
    [Subfeature root "nmcli"]
  where
-    root = IORoot cmd $ And1 (Only readEthernet) $ Only_
+    root =
-      $ sysExe networkManagerPkgs "nmcli"
+      IORoot cmd $
        And1 (Only readEthernet) $
          Only_ $
            sysExe networkManagerPkgs "nmcli"
    -- TODO make this less noisy
-    cmd iface = S.spawn
+    cmd iface =
-      $ fmtCmd "nmcli" ["-g", "GENERAL.STATE", "device", "show", iface]
+      S.spawn $
-      #!| "grep -q disconnected"
+        fmtCmd "nmcli" ["-g", "GENERAL.STATE", "device", "show", iface]
-      #!&& "a=connect"
+          #!| "grep -q disconnected"
-      #!|| "a=disconnect"
+          #!&& "a=connect"
-      #!>> fmtCmd "nmcli" ["device", "$a", iface]
+          #!|| "a=disconnect"
-      #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed"  }
+          #!>> fmtCmd "nmcli" ["device", "$a", iface]
          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "ethernet \"$a\"ed"}
 --------------------------------------------------------------------------------
-- | Configuration commands
+-- Configuration commands
 runRestart :: X ()
 runRestart = restart "xmonad" True
@ -294,14 +325,14 @@ runRecompile :: X ()
 runRecompile = do
  -- assume that the conf directory contains a valid stack project
  confDir <- asks (cfgDir . directories)
-  spawn
+  spawn $
-    $ fmtCmd "cd" [T.pack confDir]
+    fmtCmd "cd" [T.pack confDir]
-    #!&& fmtCmd "stack" ["install"]
+      #!&& fmtCmd "stack" ["install"]
-    #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
+      #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "compilation succeeded"}
-    #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
+      #!|| fmtNotifyCmd defNoteError {body = Just $ Text "compilation failed"}
 --------------------------------------------------------------------------------
-- | Screen capture commands
+-- Screen capture commands
 getCaptureDir :: IO FilePath
 getCaptureDir = do
@ -321,8 +352,10 @@ runFlameshot :: T.Text -> T.Text -> Maybe SesClient -> SometimesX
 runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd
  where
    cmd _ = spawnCmd myCapture [mode]
-    tree = toAnd_ (DBusIO $ sysExe [Package Official "flameshot"] myCapture)
+    tree =
-      $ Bus [] $ busName_ "org.flameshot.Flameshot"
+      toAnd_ (DBusIO $ sysExe [Package Official "flameshot"] myCapture) $
        Bus [] $
          busName_ "org.flameshot.Flameshot"
 -- TODO this will steal focus from the current window (and puts it
 -- in the root window?) ...need to fix
@ -338,7 +371,10 @@ runScreenCapture :: Maybe SesClient -> SometimesX
 runScreenCapture = runFlameshot "screen capture" "screen"
 runCaptureBrowser :: SometimesX
-runCaptureBrowser = sometimesIO_ "screen capture browser" "feh"
+runCaptureBrowser = sometimesIO_
-  (Only_ $ sysExe [Package Official "feh"] myImageBrowser) $ do
+  "screen capture browser"
-  dir <- io getCaptureDir
+  "feh"
-  spawnCmd myImageBrowser [T.pack dir]
+  (Only_ $ sysExe [Package Official "feh"] myImageBrowser)
  $ do
    dir <- io getCaptureDir
    spawnCmd myImageBrowser [T.pack dir]
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@ -1,10 +1,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Commands for controlling power
+-- Commands for controlling power
 module XMonad.Internal.Command.Power
-  -- commands
+-- commands
  ( runHibernate
  , runOptimusPrompt
  , runPowerOff
@ -14,10 +14,8 @@ module XMonad.Internal.Command.Power
  , runSuspend
  , runSuspendPrompt
  , runQuitPrompt
  -- daemons
  , runAutolock
  -- functions
  , hasBattery
  , suspendPrompt
@ -25,32 +23,27 @@ module XMonad.Internal.Command.Power
  , powerPrompt
  , defFontPkgs
  , promptFontDep
-  ) where
+  )
 where
-import           Data.Internal.Dependency
+import Data.Either
-
+import Data.Internal.Dependency
-import           Data.Either
+import qualified Data.Map as M
-import qualified Data.Map                    as M
+import Graphics.X11.Types
-
+import RIO
-import           Graphics.X11.Types
+import RIO.FilePath
-
+import qualified RIO.Process as P
-import           RIO
+import qualified RIO.Text as T
-import           RIO.FilePath
+import System.Directory
-import qualified RIO.Process                 as P
+import System.IO.Error
-import qualified RIO.Text                    as T
+import XMonad.Core hiding (spawn)
-
+import XMonad.Internal.Shell
-import           System.Directory
+import qualified XMonad.Internal.Theme as XT
-import           System.IO.Error
+import XMonad.Prompt
-
+import XMonad.Prompt.ConfirmPrompt
 import           XMonad.Core                 hiding (spawn)
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme       as XT
 import           XMonad.Prompt
 import           XMonad.Prompt.ConfirmPrompt
 --------------------------------------------------------------------------------
-- | Executables
+-- Executables
 myScreenlock :: FilePath
 myScreenlock = "screenlock"
@ -61,17 +54,22 @@ myPrimeOffload :: FilePath
 myPrimeOffload = "prime-offload"
 --------------------------------------------------------------------------------
-- | Packages
+-- Packages
 optimusPackages :: [Fulfillment]
 optimusPackages = [Package AUR "optimus-manager"]
 --------------------------------------------------------------------------------
-- | Core commands
+-- Core commands
 runScreenLock :: SometimesX
-runScreenLock = sometimesExe "screen locker" "i3lock script"
+runScreenLock =
-  [Package AUR "i3lock-color"] False myScreenlock
+  sometimesExe
    "screen locker"
    "i3lock script"
    [Package AUR "i3lock-color"]
    False
    myScreenlock
 runPowerOff :: X ()
 runPowerOff = spawn "systemctl poweroff"
@ -86,17 +84,19 @@ runReboot :: X ()
 runReboot = spawn "systemctl reboot"
 --------------------------------------------------------------------------------
-- | Autolock
+-- Autolock
 runAutolock :: Sometimes (FIO (P.Process () () ()))
 runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
  where
-    tree = And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock")
+    tree =
-      $ Only_ $ IOSometimes_ runScreenLock
+      And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock") $
        Only_ $
          IOSometimes_ runScreenLock
    cmd = P.proc "xss-lock" ["--ignore-sleep", "screenlock"] (P.startProcess . P.setCreateGroup True)
 --------------------------------------------------------------------------------
-- | Confirmation prompts
+-- Confirmation prompts
 promptFontDep :: IOTree XT.FontBuilder
 promptFontDep = fontTreeAlt XT.defFontFamily defFontPkgs
@ -124,7 +124,7 @@ runQuitPrompt :: SometimesX
 runQuitPrompt = sometimesPrompt "quit prompt" quitPrompt
 --------------------------------------------------------------------------------
-- | Nvidia Optimus
+-- Nvidia Optimus
 -- TODO for some reason the screen never wakes up after suspend when
 -- the nvidia card is up, so block suspend if nvidia card is running
@ -148,30 +148,36 @@ runOptimusPrompt' fb = do
  where
    switch mode = confirmPrompt' (prompt mode) (cmd mode) fb
    prompt mode = T.concat ["gpu switch to ", mode, "?"]
-    cmd mode = spawn
+    cmd mode =
-      $ T.pack myPrimeOffload
+      spawn $
-      #!&& T.unwords [T.pack myOptimusManager, "--switch", mode, "--no-confirm"]
+        T.pack myPrimeOffload
-      #!&& "killall xmonad"
+          #!&& T.unwords [T.pack myOptimusManager, "--switch", mode, "--no-confirm"]
          #!&& "killall xmonad"
 runOptimusPrompt :: SometimesX
-runOptimusPrompt = Sometimes "graphics switcher"
+runOptimusPrompt =
-  (\x -> xpfOptimus x && xpfBattery x) [s]
+  Sometimes
    "graphics switcher"
    (\x -> xpfOptimus x && xpfBattery x)
    [s]
  where
-    s = Subfeature { sfData = r, sfName = "optimus manager" }
+    s = Subfeature {sfData = r, sfName = "optimus manager"}
    r = IORoot runOptimusPrompt' t
-    t = And1 promptFontDep
+    t =
-      $ listToAnds (socketExists "optimus-manager" [] socketName)
+      And1 promptFontDep $
-      $ sysExe optimusPackages <$> [myOptimusManager, myPrimeOffload]
+        listToAnds (socketExists "optimus-manager" [] socketName) $
          sysExe optimusPackages <$> [myOptimusManager, myPrimeOffload]
    socketName = (</> "optimus-manager") <$> getTemporaryDirectory
 --------------------------------------------------------------------------------
-- | Universal power prompt
+-- Universal power prompt
-data PowerMaybeAction = Poweroff
+data PowerMaybeAction
-    | Shutdown
+  = Poweroff
-    | Hibernate
+  | Shutdown
-    | Reboot
+  | Hibernate
-    deriving (Eq)
+  | Reboot
  deriving (Eq)
 instance Enum PowerMaybeAction where
  toEnum 0 = Poweroff
@ -180,15 +186,15 @@ instance Enum PowerMaybeAction where
  toEnum 3 = Reboot
  toEnum _ = errorWithoutStackTrace "Main.Enum.PowerMaybeAction.toEnum: bad argument"
-  fromEnum Poweroff  = 0
+  fromEnum Poweroff = 0
-  fromEnum Shutdown  = 1
+  fromEnum Shutdown = 1
  fromEnum Hibernate = 2
-  fromEnum Reboot    = 3
+  fromEnum Reboot = 3
 data PowerPrompt = PowerPrompt
 instance XPrompt PowerPrompt where
-    showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"
+  showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"
 runPowerPrompt :: SometimesX
 runPowerPrompt = Sometimes "power prompt" (const True) [sf]
@ -202,20 +208,22 @@ powerPrompt :: X () -> XT.FontBuilder -> X ()
 powerPrompt lock fb = mkXPrompt PowerPrompt theme comp executeMaybeAction
  where
    comp = mkComplFunFromList theme []
-    theme = (XT.promptTheme fb) { promptKeymap = keymap }
+    theme = (XT.promptTheme fb) {promptKeymap = keymap}
-    keymap = M.fromList
+    keymap =
-      $ ((controlMask, xK_g), quit) :
+      M.fromList $
-      map (first $ (,) 0)
+        ((controlMask, xK_g), quit)
-      [ (xK_p, sendMaybeAction Poweroff)
+          : map
-      , (xK_s, sendMaybeAction Shutdown)
+            (first $ (,) 0)
-      , (xK_h, sendMaybeAction Hibernate)
+            [ (xK_p, sendMaybeAction Poweroff)
-      , (xK_r, sendMaybeAction Reboot)
+            , (xK_s, sendMaybeAction Shutdown)
-      , (xK_Return, quit)
+            , (xK_h, sendMaybeAction Hibernate)
-      , (xK_Escape, quit)
+            , (xK_r, sendMaybeAction Reboot)
-      ]
+            , (xK_Return, quit)
            , (xK_Escape, quit)
            ]
    sendMaybeAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
    executeMaybeAction a = case toEnum $ read a of
-      Poweroff  -> runPowerOff
+      Poweroff -> runPowerOff
-      Shutdown  -> lock >> runSuspend
+      Shutdown -> lock >> runSuspend
      Hibernate -> lock >> runHibernate
-      Reboot    -> runReboot
+      Reboot -> runReboot
--- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
+++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
@ -1,38 +1,37 @@
-{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Concurrent module to handle events from acpid
+-- Concurrent module to handle events from acpid
 module XMonad.Internal.Concurrent.ACPIEvent
  ( runPowermon
  , runHandleACPI
-  ) where
+  )
 where
-import           Data.Internal.Dependency
+import Data.Internal.Dependency
-
+import Network.Socket
-import           Network.Socket
+import Network.Socket.ByteString
-import           Network.Socket.ByteString
+import RIO
-
+import qualified RIO.ByteString as B
-import           RIO
+import XMonad.Core
-import qualified RIO.ByteString                           as B
+import XMonad.Internal.Command.Power
-
+import XMonad.Internal.Concurrent.ClientMessage
-import           XMonad.Core
+import XMonad.Internal.Shell
-import           XMonad.Internal.Command.Power
+import XMonad.Internal.Theme (FontBuilder)
 import           XMonad.Internal.Concurrent.ClientMessage
 import           XMonad.Internal.Shell
 import           XMonad.Internal.Theme                    (FontBuilder)
 --------------------------------------------------------------------------------
-- | Data structure to hold the ACPI events I care about
+-- Data structure to hold the ACPI events I care about
 --
 -- Enumerate so these can be converted to strings and back when sent in a
 -- ClientMessage event to X
-data ACPIEvent = Power
+data ACPIEvent
-    | Sleep
+  = Power
-    | LidClose
+  | Sleep
-    deriving (Eq)
+  | LidClose
  deriving (Eq)
 instance Enum ACPIEvent where
  toEnum 0 = Power
@ -40,24 +39,24 @@ instance Enum ACPIEvent where
  toEnum 2 = LidClose
  toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument"
-  fromEnum Power    = 0
+  fromEnum Power = 0
-  fromEnum Sleep    = 1
+  fromEnum Sleep = 1
  fromEnum LidClose = 2
 --------------------------------------------------------------------------------
-- | Internal functions
+-- Internal functions
 -- | Convert a string to an ACPI event (this string is assumed to come from
 -- the acpid socket)
 parseLine :: ByteString -> Maybe ACPIEvent
 parseLine line =
  case splitLine line of
-    (_:"PBTN":_)        -> Just Power
+    (_ : "PBTN" : _) -> Just Power
-    (_:"PWRF":_)        -> Just Power
+    (_ : "PWRF" : _) -> Just Power
-    (_:"SLPB":_)        -> Just Sleep
+    (_ : "SLPB" : _) -> Just Sleep
-    (_:"SBTN":_)        -> Just Sleep
+    (_ : "SBTN" : _) -> Just Sleep
-    (_:"LID":"close":_) -> Just LidClose
+    (_ : "LID" : "close" : _) -> Just LidClose
-    _                   -> Nothing
+    _ -> Nothing
  where
    splitLine = B.split space . B.reverse . B.dropWhile (== newline) . B.reverse
    newline = 10
@ -71,7 +70,7 @@ isDischarging :: IO (Maybe Bool)
 isDischarging = do
  status <- tryIO $ B.readFile "/sys/class/power_supply/BAT0/status"
  case status of
-    Left _  -> return Nothing
+    Left _ -> return Nothing
    Right s -> return $ Just (s == "Discharging")
 listenACPI :: IO ()
@ -103,7 +102,7 @@ handleACPI fb lock tag = do
      lock
 --------------------------------------------------------------------------------
-- | Exported API
+-- Exported API
 -- | Spawn a new thread that will listen for ACPI events on the acpid socket
 -- and send ClientMessage events when it receives them
@ -114,7 +113,9 @@ runHandleACPI :: Always (String -> X ())
 runHandleACPI = Always "ACPI event handler" $ Option sf fallback
  where
    sf = Subfeature withLock "acpid prompt"
-    withLock = IORoot (uncurry handleACPI)
+    withLock =
-      $ And12 (,) promptFontDep $ Only
+      IORoot (uncurry handleACPI) $
-      $ IOSometimes runScreenLock id
+        And12 (,) promptFontDep $
          Only $
            IOSometimes runScreenLock id
    fallback = Always_ $ FallbackAlone $ const skip
--- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs
+++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
@ -1,5 +1,5 @@
 --------------------------------------------------------------------------------
-- | Core ClientMessage module to 'achieve' concurrency in XMonad
+-- Core ClientMessage module to 'achieve' concurrency in XMonad
 --
 -- Since XMonad is single threaded, the only way to have multiple threads that
 -- listen/react to non-X events is to spawn other threads the run outside of
@ -16,50 +16,50 @@
 -- much like something from X even though it isn't
 module XMonad.Internal.Concurrent.ClientMessage
-  ( XMsgType(..)
+  ( XMsgType (..)
  , sendXMsg
  , splitXMsg
-  ) where
+  )
 where
-import           Data.Char
+import Data.Char
-
+import Graphics.X11.Types
-import           Graphics.X11.Types
+import Graphics.X11.Xlib.Atom
-import           Graphics.X11.Xlib.Atom
+import Graphics.X11.Xlib.Display
-import           Graphics.X11.Xlib.Display
+import Graphics.X11.Xlib.Event
-import           Graphics.X11.Xlib.Event
+import Graphics.X11.Xlib.Extras
-import           Graphics.X11.Xlib.Extras
+import Graphics.X11.Xlib.Types
-import           Graphics.X11.Xlib.Types
+import RIO hiding (Display)
 import           RIO                       hiding (Display)
 --------------------------------------------------------------------------------
-- | Data structure for the ClientMessage
+-- Data structure for the ClientMessage
 --
 -- These are the "types" of client messages to send; add more here as needed
 -- TODO is there a way to do this in the libraries that import this one?
-data XMsgType = ACPI
+data XMsgType
-    | Workspace
+  = ACPI
-    | Unknown
+  | Workspace
-    deriving (Eq, Show)
+  | Unknown
  deriving (Eq, Show)
 instance Enum XMsgType where
  toEnum 0 = ACPI
  toEnum 1 = Workspace
  toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument"
-  fromEnum ACPI      = 0
+  fromEnum ACPI = 0
  fromEnum Workspace = 1
-  fromEnum Unknown   = 2
+  fromEnum Unknown = 2
 --------------------------------------------------------------------------------
-- | Exported API
+-- Exported API
 -- | Given a string from the data field in a ClientMessage event, return the
 -- type and payload
 splitXMsg :: (Integral a) => [a] -> (XMsgType, String)
 splitXMsg [] = (Unknown, "")
-splitXMsg (x:xs) = (xtype, tag)
+splitXMsg (x : xs) = (xtype, tag)
  where
    xtype = toEnum $ fromIntegral x
    tag = chr . fromIntegral <$> takeWhile (/= 0) xs
@ -91,7 +91,7 @@ sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
    -- longer will be clipped to 19, and anything less than 19 will be padded
    -- with 0 (note this used to be random garbage before). See this function
    -- for more details.
-    setClientMessageEvent' e root bITMAP 8 (x:t)
+    setClientMessageEvent' e root bITMAP 8 (x : t)
    sendEvent dpy root False substructureNotifyMask e
  where
    x = fromIntegral $ fromEnum xtype
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@ -1,5 +1,5 @@
 --------------------------------------------------------------------------------
-- | Automatically Manage Dynamic Workspaces
+-- Automatically Manage Dynamic Workspaces
 -- This is a somewhat convoluted wrapper for the Dymamic Workspaces module
 -- in the contrib library. The general behavior this allows:
 -- 1) launch app
@ -24,72 +24,66 @@
 -- 3) Virtualbox (should always be by itself anyways)
 module XMonad.Internal.Concurrent.DynamicWorkspaces
-  ( DynWorkspace(..)
+  ( DynWorkspace (..)
  , appendShift
  , appendViewShift
  , removeDynamicWorkspace
  , runWorkspaceMon
  , spawnOrSwitch
  , doSink
-  ) where
+  )
-
+where
 import           Data.List                                (deleteBy, find)
 import qualified Data.Map                                 as M
 import           Data.Maybe
 -- import           Control.Concurrent
-import           Control.Monad
+import Control.Monad
-import           Control.Monad.Reader
+import Control.Monad.Reader
-
+import Data.List (deleteBy, find)
-
+import qualified Data.Map as M
-import           Graphics.X11.Types
+import Data.Maybe
-
+import Graphics.X11.Types
-import           Graphics.X11.Xlib.Atom
+import Graphics.X11.Xlib.Atom
-import           Graphics.X11.Xlib.Display
+import Graphics.X11.Xlib.Display
-import           Graphics.X11.Xlib.Event
+import Graphics.X11.Xlib.Event
-import           Graphics.X11.Xlib.Extras
+import Graphics.X11.Xlib.Extras
-import           Graphics.X11.Xlib.Misc
+import Graphics.X11.Xlib.Misc
-import           Graphics.X11.Xlib.Types
+import Graphics.X11.Xlib.Types
-
+import RIO hiding
-import           RIO                                      hiding
+  ( Display
-    ( Display
+  , display
-    , display
+  )
-    )
+import qualified RIO.Set as S
-import qualified RIO.Set                                  as S
+import System.Process
-
+import XMonad.Actions.DynamicWorkspaces
-import           System.Process
+import XMonad.Core
-
+  ( ManageHook
-import           XMonad.Actions.DynamicWorkspaces
+  , WorkspaceId
-import           XMonad.Core
+  , X
-    ( ManageHook
+  , io
-    , WorkspaceId
+  , withWindowSet
-    , X
+  )
-    , io
+import XMonad.Hooks.ManageHelpers (MaybeManageHook)
-    , withWindowSet
+import XMonad.Internal.Concurrent.ClientMessage
-    )
+import XMonad.Internal.IO
-import           XMonad.Hooks.ManageHelpers               (MaybeManageHook)
+import XMonad.ManageHook
-import           XMonad.Internal.Concurrent.ClientMessage
+import XMonad.Operations
-import           XMonad.Internal.IO
+import qualified XMonad.StackSet as W
 import           XMonad.ManageHook
 import           XMonad.Operations
 import qualified XMonad.StackSet                          as W
 --------------------------------------------------------------------------------
-- | Dynamic Workspace datatype
+-- Dynamic Workspace datatype
-- This hold all the data needed to tie an app to a particular dynamic workspace
+-- This holds all the data needed to tie an app to a particular dynamic workspace
 data DynWorkspace = DynWorkspace
-    { dwName  :: String
+  { dwName :: String
-    , dwTag   :: WorkspaceId
+  , dwTag :: WorkspaceId
-    , dwClass :: String
+  , dwClass :: String
-    , dwHook  :: [MaybeManageHook]
+  , dwHook :: [MaybeManageHook]
-    , dwKey   :: Char
+  , dwKey :: Char
-    , dwCmd   :: Maybe (X ())
+  , dwCmd :: Maybe (X ())
-    -- TODO this should also have the layout for this workspace
+  -- TODO this should also have the layout for this workspace
-    }
+  }
 --------------------------------------------------------------------------------
-- | Manager thread
+-- Manager thread
 -- The main thread that watches for new windows. When a match is found, this
 -- thread spawns a new thread the waits for the PID of the window to exit. When
 -- the PID exits, it sends a ClientMessage event to X
@ -99,10 +93,10 @@ data DynWorkspace = DynWorkspace
 -- type MatchTags = M.Map String String
 data WConf = WConf
-    { display       :: Display
+  { display :: Display
-    , dynWorkspaces :: [DynWorkspace]
+  , dynWorkspaces :: [DynWorkspace]
-    , curPIDs       :: MVar (S.Set Pid)
+  , curPIDs :: MVar (S.Set Pid)
-    }
+  }
 type W a = RIO WConf ()
@ -120,51 +114,56 @@ runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
  where
    withEvents dpy e = do
      ps <- newMVar S.empty
-      let c = WConf { display = dpy, dynWorkspaces = dws, curPIDs = ps }
+      let c = WConf {display = dpy, dynWorkspaces = dws, curPIDs = ps}
-      runRIO c
+      runRIO c $
-        $ forever
+        forever $
-        $ handleEvent =<< io (nextEvent dpy e >> getEvent e)
+          handleEvent =<< io (nextEvent dpy e >> getEvent e)
 handleEvent :: Event -> W ()
 -- | assume this fires at least once when a new window is created (also could
 -- use CreateNotify but that is really noisy)
-handleEvent MapNotifyEvent { ev_window = w } = do
+handleEvent MapNotifyEvent {ev_window = w} = do
  dpy <- asks display
  hint <- io $ getClassHint dpy w
  dws <- asks dynWorkspaces
-  let tag = M.lookup (resClass hint)
+  let tag =
-            $ M.fromList
+        M.lookup (resClass hint) $
-            $ fmap (\DynWorkspace { dwTag = t, dwClass = c } -> (c, t)) dws
+          M.fromList $
            fmap (\DynWorkspace {dwTag = t, dwClass = c} -> (c, t)) dws
  forM_ tag $ \t -> do
    a <- io $ internAtom dpy "_NET_WM_PID" False
    pid <- io $ getWindowProperty32 dpy a w
    case pid of
      -- ASSUMPTION windows will only have one PID at one time
      Just [p] -> let p' = fromIntegral p in void $ async $ withUniquePid p' t
-      _        -> return ()
+      _ -> return ()
 handleEvent _ = return ()
 withUniquePid :: Pid -> String -> W ()
 withUniquePid pid tag = do
  ps <- asks curPIDs
  pids <- readMVar ps
-  io $ unless (pid `elem` pids) $ bracket_
+  io
-    (modifyMVar_ ps (return . S.insert pid))
+    $ unless (pid `elem` pids)
-    (modifyMVar_ ps (return . S.delete pid))
+    $ bracket_
      (modifyMVar_ ps (return . S.insert pid))
      (modifyMVar_ ps (return . S.delete pid))
    $ waitUntilExit pid >> sendXMsg Workspace tag
 --------------------------------------------------------------------------------
-- | Launching apps
+-- Launching apps
 -- When launching apps on dymamic workspaces, first check if they are running
 -- and launch if not, then switch to their workspace
 wsOccupied :: Eq a1 => a1 -> W.StackSet a1 l a2 sid sd -> Bool
-wsOccupied tag ws = elem tag $ map W.tag $ filter (isJust . W.stack)
+wsOccupied tag ws =
-  -- list of all workspaces with windows on them
+  elem tag $
-  -- TODO is there not a better way to do this?
+    map W.tag $
-  $ W.workspace (W.current ws) : W.hidden ws ++ map W.workspace (W.visible ws)
+      filter (isJust . W.stack)
      -- list of all workspaces with windows on them
      -- TODO is there not a better way to do this?
      $
        W.workspace (W.current ws) : W.hidden ws ++ map W.workspace (W.visible ws)
 spawnOrSwitch :: WorkspaceId -> X () -> X ()
 spawnOrSwitch tag cmd = do
@ -172,7 +171,7 @@ spawnOrSwitch tag cmd = do
  if occupied then windows $ W.view tag else cmd
 --------------------------------------------------------------------------------
-- | Managehook
+-- Managehook
 -- Move windows to new workspace if they are part of a dynamic workspace
 -- shamelessly ripped off from appendWorkspace (this analogue doesn't exist)
@ -193,29 +192,31 @@ appendViewShift tag = liftX (appendWorkspace tag) >> viewShift tag
 -- TODO surprisingly this doesn't exist? We shouldn't need to TBH
 doSink :: ManageHook
 doSink = doF $ \s -> case W.stack $ W.workspace $ W.current s of
-                       Just s' -> W.sink (W.focus s') s
+  Just s' -> W.sink (W.focus s') s
-                       Nothing -> s
+  Nothing -> s
 --------------------------------------------------------------------------------
-- | Eventhook
+-- Eventhook
 -- When an app is closed, this will respond the event that is sent in the main
 -- XMonad thread
 removeDynamicWorkspace :: WorkspaceId -> X ()
 removeDynamicWorkspace target = windows removeIfEmpty
  where
    -- remove workspace if it is empty and if there are hidden workspaces
-    removeIfEmpty s@W.StackSet { W.visible = vis, W.hidden = hall@(h:hs) }
+    removeIfEmpty s@W.StackSet {W.visible = vis, W.hidden = hall@(h : hs)}
      -- if hidden, delete from hidden
-      | Just x <- find isEmptyTarget hall
+      | Just x <- find isEmptyTarget hall =
-      = s { W.hidden = deleteBy (eq W.tag) x hall }
+          s {W.hidden = deleteBy (eq W.tag) x hall}
      -- if visible, delete from visible and move first hidden to its place
-      | Just x <- find (isEmptyTarget . W.workspace) vis
+      | Just x <- find (isEmptyTarget . W.workspace) vis =
-      = s { W.visible = x { W.workspace = h } : deleteBy (eq W.screen) x vis
+          s
-          , W.hidden = hs }
+            { W.visible = x {W.workspace = h} : deleteBy (eq W.screen) x vis
            , W.hidden = hs
            }
      -- if current, move the first hidden workspace to the current
-      | isEmptyTarget $ W.workspace $ W.current s
+      | isEmptyTarget $ W.workspace $ W.current s =
-      = s { W.current = (W.current s) { W.workspace = h }, W.hidden = hs }
+          s {W.current = (W.current s) {W.workspace = h}, W.hidden = hs}
      -- otherwise do nothing
      | otherwise = s
    removeIfEmpty s = s
--- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs
+++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
@ -1,25 +1,23 @@
-{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 --------------------------------------------------------------------------------
-- | VirtualBox-specific functions
+-- VirtualBox-specific functions
 module XMonad.Internal.Concurrent.VirtualBox
  ( vmExists
  , vmInstanceConfig
  , qual
-  ) where
+  )
 where
-import           Data.Internal.Dependency
+import Data.Internal.Dependency
-
+import RIO hiding (try)
-import           Text.XML.Light
+import RIO.Directory
-
+import RIO.FilePath
-import           RIO                      hiding (try)
+import qualified RIO.Text as T
-import           RIO.Directory
+import Text.XML.Light
-import           RIO.FilePath
+import XMonad.Internal.Shell
 import qualified RIO.Text                 as T
 import           XMonad.Internal.Shell
 vmExists :: T.Text -> IO (Maybe Msg)
 vmExists vm = either (Just . Msg LevelError) (const Nothing) <$> vmInstanceConfig vm
@ -32,7 +30,7 @@ vmInstanceConfig vmName = do
    findInstance dir = do
      res <- findFile [dir] path
      return $ case res of
-        Just p  -> Right p
+        Just p -> Right p
        Nothing -> Left $ T.append "could not find VM instance: " $ singleQuote vmName
 vmDirectory :: IO (Either String String)
@ -41,15 +39,17 @@ vmDirectory = do
  s <- tryIO $ readFile p
  return $ case s of
    (Left _) -> Left "could not read VirtualBox config file"
-    (Right x) -> maybe (Left "Could not parse VirtualBox config file") Right
+    (Right x) ->
-                 $ findDir =<< parseXMLDoc x
+      maybe (Left "Could not parse VirtualBox config file") Right $
        findDir =<< parseXMLDoc x
  where
-    findDir e = findAttr (unqual "defaultMachineFolder")
+    findDir e =
-      =<< findChild (qual e "SystemProperties")
+      findAttr (unqual "defaultMachineFolder")
-      =<< findChild (qual e "Global") e
+        =<< findChild (qual e "SystemProperties")
        =<< findChild (qual e "Global") e
 qual :: Element -> String -> QName
-qual e n = (elName e) { qName = n }
+qual e n = (elName e) {qName = n}
 vmConfig :: IO FilePath
 vmConfig = getXdgDirectory XdgConfig "VirtualBox/VirtualBox.xml"
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | DBus module for Clevo Keyboard control
+-- DBus module for Clevo Keyboard control
 module XMonad.Internal.DBus.Brightness.ClevoKeyboard
  ( callGetBrightnessCK
@ -10,24 +10,21 @@ module XMonad.Internal.DBus.Brightness.ClevoKeyboard
  , clevoKeyboardControls
  , clevoKeyboardSignalDep
  , blPath
-  ) where
+  )
 where
-import           Control.Monad                          (when)
+import Control.Monad (when)
-
+import DBus
-import           Data.Int                               (Int32)
+import Data.Int (Int32)
-import           Data.Internal.DBus
+import Data.Internal.DBus
-import           Data.Internal.Dependency
+import Data.Internal.Dependency
-
+import RIO.FilePath
-import           DBus
+import XMonad.Internal.DBus.Brightness.Common
-
+import XMonad.Internal.IO
 import           RIO.FilePath
 import           XMonad.Internal.DBus.Brightness.Common
 import           XMonad.Internal.IO
 --------------------------------------------------------------------------------
-- | Low level sysfs functions
+-- Low level sysfs functions
--
+
 type Brightness = Float
 type RawBrightness = Int32
@ -84,7 +81,7 @@ decBrightness bounds = do
  return b
 --------------------------------------------------------------------------------
-- | DBus interface
+-- DBus interface
 blPath :: ObjectPath
 blPath = objectPath_ "/clevo_keyboard"
@ -93,21 +90,22 @@ interface :: InterfaceName
 interface = interfaceName_ "org.xmonad.Brightness"
 clevoKeyboardConfig :: BrightnessConfig RawBrightness Brightness
-clevoKeyboardConfig = BrightnessConfig
+clevoKeyboardConfig =
-  { bcMin = minBrightness
+  BrightnessConfig
-  , bcMax = maxBrightness
+    { bcMin = minBrightness
-  , bcInc = incBrightness
+    , bcMax = maxBrightness
-  , bcDec = decBrightness
+    , bcInc = incBrightness
-  , bcGet = getBrightness
+    , bcDec = decBrightness
-  , bcGetMax = return maxRawBrightness
+    , bcGet = getBrightness
-  , bcMinRaw = minRawBrightness
+    , bcGetMax = return maxRawBrightness
-  , bcPath = blPath
+    , bcMinRaw = minRawBrightness
-  , bcInterface = interface
+    , bcPath = blPath
-  , bcName = "Clevo keyboard"
+    , bcInterface = interface
-  }
+    , bcName = "Clevo keyboard"
    }
 --------------------------------------------------------------------------------
-- | Exported haskell API
+-- Exported haskell API
 stateFileDep :: IODependency_
 stateFileDep = pathRW stateFile [Package AUR "tuxedo-keyboard"]
@ -119,8 +117,12 @@ clevoKeyboardSignalDep :: DBusDependency_ SesClient
 clevoKeyboardSignalDep = signalDep clevoKeyboardConfig
 exportClevoKeyboard :: Maybe SesClient -> SometimesIO
-exportClevoKeyboard = brightnessExporter xpfClevoBacklight []
+exportClevoKeyboard =
-  [stateFileDep, brightnessFileDep] clevoKeyboardConfig
+  brightnessExporter
    xpfClevoBacklight
    []
    [stateFileDep, brightnessFileDep]
    clevoKeyboardConfig
 clevoKeyboardControls :: Maybe SesClient -> BrightnessControls
 clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@ -1,35 +1,32 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | DBus module for DBus brightness controls
+-- DBus module for DBus brightness controls
 module XMonad.Internal.DBus.Brightness.Common
-  ( BrightnessConfig(..)
+  ( BrightnessConfig (..)
-  , BrightnessControls(..)
+  , BrightnessControls (..)
  , brightnessControls
  , brightnessExporter
  , callGetBrightness
  , matchSignal
  , signalDep
-  ) where
+  )
 where
-import           Control.Monad               (void)
+import Control.Monad (void)
-
+import DBus
-import           Data.Int                    (Int32)
+import DBus.Client
-import           Data.Internal.DBus
+import qualified DBus.Introspection as I
-import           Data.Internal.Dependency
+import Data.Int (Int32)
-
+import Data.Internal.DBus
-import           DBus
+import Data.Internal.Dependency
-import           DBus.Client
+import qualified RIO.Text as T
-import qualified DBus.Introspection          as I
+import XMonad.Core (io)
-
+import XMonad.Internal.DBus.Common
 import qualified RIO.Text                    as T
 import           XMonad.Core                 (io)
 import           XMonad.Internal.DBus.Common
 --------------------------------------------------------------------------------
-- | External API
+-- External API
 --
 -- Define four methods to increase, decrease, maximize, or minimize the
 -- brightness. These methods will all return the current brightness as a 32-bit
@ -37,16 +34,16 @@ import           XMonad.Internal.DBus.Common
 -- is one method to get the current brightness.
 data BrightnessConfig a b = BrightnessConfig
-  { bcMin       :: (a, a) -> IO b
+  { bcMin :: (a, a) -> IO b
-  , bcMax       :: (a, a) -> IO b
+  , bcMax :: (a, a) -> IO b
-  , bcDec       :: (a, a) -> IO b
+  , bcDec :: (a, a) -> IO b
-  , bcInc       :: (a, a) -> IO b
+  , bcInc :: (a, a) -> IO b
-  , bcGet       :: (a, a) -> IO b
+  , bcGet :: (a, a) -> IO b
-  , bcMinRaw    :: a
+  , bcMinRaw :: a
-  , bcGetMax    :: IO a
+  , bcGetMax :: IO a
-  , bcPath      :: ObjectPath
+  , bcPath :: ObjectPath
  , bcInterface :: InterfaceName
-  , bcName      :: T.Text
+  , bcName :: T.Text
  }
 data BrightnessControls = BrightnessControls
@ -56,46 +53,63 @@ data BrightnessControls = BrightnessControls
  , bctlDec :: SometimesX
  }
-brightnessControls :: XPQuery -> BrightnessConfig a b -> Maybe SesClient
+brightnessControls
  :: XPQuery
  -> BrightnessConfig a b
  -> Maybe SesClient
  -> BrightnessControls
 brightnessControls q bc cl =
  BrightnessControls
-  { bctlMax = cb "max brightness" memMax
+    { bctlMax = cb "max brightness" memMax
-  , bctlMin = cb "min brightness" memMin
+    , bctlMin = cb "min brightness" memMin
-  , bctlInc = cb "increase brightness" memInc
+    , bctlInc = cb "increase brightness" memInc
-  , bctlDec = cb "decrease brightness" memDec
+    , bctlDec = cb "decrease brightness" memDec
-  }
+    }
  where
    cb = callBacklight q cl bc
-callGetBrightness :: (SafeClient c, Num n) => BrightnessConfig a b -> c
+callGetBrightness
  :: (SafeClient c, Num n)
  => BrightnessConfig a b
  -> c
  -> IO (Maybe n)
-callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } client =
+callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} client =
  either (const Nothing) bodyGetBrightness
-  <$> callMethod client xmonadBusName p i memGet
+    <$> callMethod client xmonadBusName p i memGet
 signalDep :: BrightnessConfig a b -> DBusDependency_ SesClient
-signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
+signalDep BrightnessConfig {bcPath = p, bcInterface = i} =
  Endpoint [] xmonadBusName p i $ Signal_ memCur
-matchSignal :: (SafeClient c, Num n) => BrightnessConfig a b
+matchSignal
-  -> (Maybe n-> IO ()) -> c -> IO ()
+  :: (SafeClient c, Num n)
-matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb =
+  => BrightnessConfig a b
  -> (Maybe n -> IO ())
  -> c
  -> IO ()
 matchSignal BrightnessConfig {bcPath = p, bcInterface = i} cb =
  void . addMatchCallback brMatcher (cb . bodyGetBrightness)
  where
    -- TODO add busname to this
-    brMatcher = matchAny
+    brMatcher =
-      { matchPath = Just p
+      matchAny
-      , matchInterface = Just i
+        { matchPath = Just p
-      , matchMember = Just memCur
+        , matchInterface = Just i
-      }
+        , matchMember = Just memCur
        }
 --------------------------------------------------------------------------------
-- | Internal DBus Crap
+-- Internal DBus Crap
-brightnessExporter :: RealFrac b => XPQuery -> [Fulfillment] -> [IODependency_]
+brightnessExporter
-  -> BrightnessConfig a b -> Maybe SesClient -> SometimesIO
+  :: RealFrac b
-brightnessExporter q ful deps bc@BrightnessConfig { bcName = n } cl =
+  => XPQuery
  -> [Fulfillment]
  -> [IODependency_]
  -> BrightnessConfig a b
  -> Maybe SesClient
  -> SometimesIO
 brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
  Sometimes (T.append n " DBus Interface") q [Subfeature root "exporter"]
  where
    root = DBusRoot_ (exportBrightnessControls' bc) tree cl
@ -108,51 +122,66 @@ exportBrightnessControls' bc cl = io $ do
  let bounds = (bcMinRaw bc, maxval)
  let autoMethod' m f = autoMethod m $ emitBrightness bc ses =<< f bc bounds
  let funget = bcGet bc
-  export ses (bcPath bc) defaultInterface
+  export
-    { interfaceName = bcInterface bc
+    ses
-    , interfaceMethods =
+    (bcPath bc)
-      [ autoMethod' memMax bcMax
+    defaultInterface
-      , autoMethod' memMin bcMin
+      { interfaceName = bcInterface bc
-      , autoMethod' memInc bcInc
+      , interfaceMethods =
-      , autoMethod' memDec bcDec
+          [ autoMethod' memMax bcMax
-      , autoMethod memGet (round <$> funget bounds :: IO Int32)
+          , autoMethod' memMin bcMin
-      ]
+          , autoMethod' memInc bcInc
-    , interfaceSignals = [sig]
+          , autoMethod' memDec bcDec
-    }
+          , autoMethod memGet (round <$> funget bounds :: IO Int32)
-  where
+          ]
-    sig = I.Signal
+      , interfaceSignals = [sig]
      { I.signalName = memCur
      , I.signalArgs =
        [
          I.SignalArg
          { I.signalArgName = "brightness"
          , I.signalArgType = TypeInt32
          }
        ]
      }
  where
    sig =
      I.Signal
        { I.signalName = memCur
        , I.signalArgs =
            [ I.SignalArg
                { I.signalArgName = "brightness"
                , I.signalArgType = TypeInt32
                }
            ]
        }
 emitBrightness :: RealFrac b => BrightnessConfig a b -> Client -> b -> IO ()
-emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
+emitBrightness BrightnessConfig {bcPath = p, bcInterface = i} client cur =
-  emit client $ sig { signalBody = [toVariant (round cur :: Int32)] }
+  emit client $ sig {signalBody = [toVariant (round cur :: Int32)]}
  where
    sig = signal p i memCur
-callBacklight :: XPQuery -> Maybe SesClient -> BrightnessConfig a b -> T.Text
+callBacklight
-  -> MemberName -> SometimesX
+  :: XPQuery
-callBacklight q cl BrightnessConfig { bcPath = p
+  -> Maybe SesClient
-                                    , bcInterface = i
+  -> BrightnessConfig a b
-                                    , bcName = n } controlName m =
+  -> T.Text
-  Sometimes (T.unwords [n, controlName]) q [Subfeature root "method call"]
+  -> MemberName
-  where
+  -> SometimesX
-    root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
+callBacklight
-    cmd c = io $ void $ callMethod c xmonadBusName p i m
+  q
  cl
  BrightnessConfig
    { bcPath = p
    , bcInterface = i
    , bcName = n
    }
  controlName
  m =
    Sometimes (T.unwords [n, controlName]) q [Subfeature root "method call"]
    where
      root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
      cmd c = io $ void $ callMethod c xmonadBusName p i m
 bodyGetBrightness :: Num a => [Variant] -> Maybe a
 bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
-bodyGetBrightness _   = Nothing
+bodyGetBrightness _ = Nothing
 --------------------------------------------------------------------------------
-- | DBus Members
+-- DBus Members
 memCur :: MemberName
 memCur = memberName_ "CurrentBrightness"
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | DBus module for Intel Backlight control
+-- DBus module for Intel Backlight control
 module XMonad.Internal.DBus.Brightness.IntelBacklight
  ( callGetBrightnessIB
@ -10,22 +10,20 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
  , intelBacklightControls
  , intelBacklightSignalDep
  , blPath
-  ) where
+  )
 where
-import           Data.Int                               (Int32)
+import DBus
-import           Data.Internal.DBus
+import Data.Int (Int32)
-import           Data.Internal.Dependency
+import Data.Internal.DBus
-
+import Data.Internal.Dependency
-import           DBus
+import RIO.FilePath
-
+import XMonad.Internal.DBus.Brightness.Common
-import           RIO.FilePath
+import XMonad.Internal.IO
 import           XMonad.Internal.DBus.Brightness.Common
 import           XMonad.Internal.IO
 --------------------------------------------------------------------------------
-- | Low level sysfs functions
+-- Low level sysfs functions
--
+
 type Brightness = Float
 type RawBrightness = Int32
@ -66,7 +64,7 @@ decBrightness :: RawBounds -> IO Brightness
 decBrightness = decPercent steps curFile
 --------------------------------------------------------------------------------
-- | DBus interface
+-- DBus interface
 blPath :: ObjectPath
 blPath = objectPath_ "/intelbacklight"
@ -75,21 +73,22 @@ interface :: InterfaceName
 interface = interfaceName_ "org.xmonad.Brightness"
 intelBacklightConfig :: BrightnessConfig RawBrightness Brightness
-intelBacklightConfig = BrightnessConfig
+intelBacklightConfig =
-  { bcMin = minBrightness
+  BrightnessConfig
-  , bcMax = maxBrightness
+    { bcMin = minBrightness
-  , bcInc = incBrightness
+    , bcMax = maxBrightness
-  , bcDec = decBrightness
+    , bcInc = incBrightness
-  , bcGet = getBrightness
+    , bcDec = decBrightness
-  , bcGetMax = getMaxRawBrightness
+    , bcGet = getBrightness
-  , bcMinRaw = minRawBrightness
+    , bcGetMax = getMaxRawBrightness
-  , bcPath = blPath
+    , bcMinRaw = minRawBrightness
-  , bcInterface = interface
+    , bcPath = blPath
-  , bcName = "Intel backlight"
+    , bcInterface = interface
-  }
+    , bcName = "Intel backlight"
    }
 --------------------------------------------------------------------------------
-- | Exported haskell API
+-- Exported haskell API
 curFileDep :: IODependency_
 curFileDep = pathRW curFile []
@ -101,8 +100,12 @@ intelBacklightSignalDep :: DBusDependency_ SesClient
 intelBacklightSignalDep = signalDep intelBacklightConfig
 exportIntelBacklight :: Maybe SesClient -> SometimesIO
-exportIntelBacklight = brightnessExporter xpfIntelBacklight []
+exportIntelBacklight =
-  [curFileDep, maxFileDep] intelBacklightConfig
+  brightnessExporter
    xpfIntelBacklight
    []
    [curFileDep, maxFileDep]
    intelBacklightConfig
 intelBacklightControls :: Maybe SesClient -> BrightnessControls
 intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig
--- a/lib/XMonad/Internal/DBus/Common.hs
+++ b/lib/XMonad/Internal/DBus/Common.hs
@ -1,5 +1,5 @@
 --------------------------------------------------------------------------------
-- | High-level interface for managing XMonad's DBus
+-- High-level interface for managing XMonad's DBus
 module XMonad.Internal.DBus.Common
  ( xmonadBusName
@ -7,9 +7,10 @@ module XMonad.Internal.DBus.Common
  , notifyBus
  , notifyPath
  , networkManagerBus
-  ) where
+  )
 where
-import           DBus
+import DBus
 xmonadBusName :: BusName
 xmonadBusName = busName_ "org.xmonad"
@ -25,4 +26,3 @@ notifyPath = objectPath_ "/org/freedesktop/Notifications"
 networkManagerBus :: BusName
 networkManagerBus = busName_ "org.freedesktop.NetworkManager"
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@ -1,11 +1,11 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 --------------------------------------------------------------------------------
-- | High-level interface for managing XMonad's DBus
+-- High-level interface for managing XMonad's DBus
 module XMonad.Internal.DBus.Control
  ( Client
-  , DBusState(..)
+  , DBusState (..)
  , connectDBus
  , connectDBusX
  , disconnectDBus
@ -15,33 +15,31 @@ module XMonad.Internal.DBus.Control
  , withDBusClient_
  , disconnect
  , dbusExporters
-  ) where
+  )
 where
-import           Control.Monad
+import Control.Monad
-
+import DBus
-import           Data.Internal.DBus
+import DBus.Client
-import           Data.Internal.Dependency
+import Data.Internal.DBus
-
+import Data.Internal.Dependency
-import           DBus
+import XMonad.Internal.DBus.Brightness.ClevoKeyboard
-import           DBus.Client
+import XMonad.Internal.DBus.Brightness.IntelBacklight
-
+import XMonad.Internal.DBus.Common
-import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
+import XMonad.Internal.DBus.Screensaver
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.DBus.Screensaver
 -- | Current connections to the DBus (session and system buses)
 data DBusState = DBusState
-    { dbSesClient :: Maybe SesClient
+  { dbSesClient :: Maybe SesClient
-    , dbSysClient :: Maybe SysClient
+  , dbSysClient :: Maybe SysClient
-    }
+  }
 -- | Connect to the DBus
 connectDBus :: IO DBusState
 connectDBus = do
  ses <- getDBusClient
  sys <- getDBusClient
-  return DBusState { dbSesClient = ses, dbSysClient = sys }
+  return DBusState {dbSesClient = ses, dbSysClient = sys}
 -- | Disconnect from the DBus
 disconnectDBus :: DBusState -> IO ()
@ -73,11 +71,13 @@ requestXMonadName :: SesClient -> IO ()
 requestXMonadName ses = do
  res <- requestName (toClient ses) xmonadBusName []
  -- TODO if the client is not released on shutdown the owner will be different
-  let msg | res == NamePrimaryOwner = Nothing
+  let msg
-          | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
+        | res == NamePrimaryOwner = Nothing
-          | res == NameInQueue
+        | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
-            || res == NameExists = Just $ "another process owns " ++ xn
+        | res == NameInQueue
-          | otherwise = Just $ "unknown error when requesting " ++ xn
+            || res == NameExists =
            Just $ "another process owns " ++ xn
        | otherwise = Just $ "unknown error when requesting " ++ xn
  forM_ msg putStrLn
  where
    xn = "'" ++ formatBusName xmonadBusName ++ "'"
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@ -1,24 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Module for monitoring removable drive events
+-- Module for monitoring removable drive events
 --
 -- Currently, its only purpose is to play Super Mario sounds when a drive is
 -- inserted or removed. Why? Because I can.
 module XMonad.Internal.DBus.Removable (runRemovableMon) where
-import           Control.Monad
+import Control.Monad
-
+import DBus
-import           Data.Internal.DBus
+import DBus.Client
-import           Data.Internal.Dependency
+import Data.Internal.DBus
-import           Data.Map.Strict                 (Map, member)
+import Data.Internal.Dependency
-
+import Data.Map.Strict (Map, member)
-import           DBus
+import XMonad.Core (io)
-import           DBus.Client
+import XMonad.Internal.Command.Desktop
 import           XMonad.Core                     (io)
 import           XMonad.Internal.Command.Desktop
 bus :: BusName
 bus = busName_ "org.freedesktop.UDisks2"
@ -51,22 +48,29 @@ driveRemovedSound :: FilePath
 driveRemovedSound = "smb_pipe.wav"
 ruleUdisks :: MatchRule
-ruleUdisks = matchAny
+ruleUdisks =
-  { matchPath = Just path
+  matchAny
-  , matchInterface = Just interface
+    { matchPath = Just path
-  }
+    , matchInterface = Just interface
    }
 driveFlag :: String
 driveFlag = "org.freedesktop.UDisks2.Drive"
 addedHasDrive :: [Variant] -> Bool
-addedHasDrive [_, a] = maybe False (member driveFlag)
+addedHasDrive [_, a] =
-  (fromVariant a :: Maybe (Map String (Map String Variant)))
+  maybe
    False
    (member driveFlag)
    (fromVariant a :: Maybe (Map String (Map String Variant)))
 addedHasDrive _ = False
 removedHasDrive :: [Variant] -> Bool
-removedHasDrive [_, a] = maybe False (driveFlag `elem`)
+removedHasDrive [_, a] =
-  (fromVariant a :: Maybe [String])
+  maybe
    False
    (driveFlag `elem`)
    (fromVariant a :: Maybe [String])
 removedHasDrive _ = False
 playSoundMaybe :: FilePath -> Bool -> IO ()
@ -81,8 +85,10 @@ listenDevices cl = do
  addMatch' memAdded driveInsertedSound addedHasDrive
  addMatch' memRemoved driveRemovedSound removedHasDrive
  where
-    addMatch' m p f = void $ addMatch (toClient cl) ruleUdisks { matchMember = Just m }
+    addMatch' m p f =
-      $ playSoundMaybe p . f . signalBody
+      void $
        addMatch (toClient cl) ruleUdisks {matchMember = Just m} $
          playSoundMaybe p . f . signalBody
 runRemovableMon :: Maybe SysClient -> SometimesIO
 runRemovableMon cl =
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | DBus module for X11 screensave/DPMS control
+-- DBus module for X11 screensave/DPMS control
 module XMonad.Internal.DBus.Screensaver
  ( exportScreensaver
@ -9,25 +9,22 @@ module XMonad.Internal.DBus.Screensaver
  , callQuery
  , matchSignal
  , ssSignalDep
-  ) where
+  )
 where
-import           Data.Internal.DBus
+import DBus
-import           Data.Internal.Dependency
+import DBus.Client
-
+import qualified DBus.Introspection as I
-import           RIO
+import Data.Internal.DBus
-
+import Data.Internal.Dependency
-import           DBus
+import Graphics.X11.XScreenSaver
-import           DBus.Client
+import Graphics.X11.Xlib.Display
-import qualified DBus.Introspection          as I
+import RIO
-
+import XMonad.Internal.DBus.Common
-import           Graphics.X11.XScreenSaver
+import XMonad.Internal.Shell
 import           Graphics.X11.Xlib.Display
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Shell
 --------------------------------------------------------------------------------
-- | Low-level functions
+-- Low-level functions
 type SSState = Bool -- true is enabled
@ -50,13 +47,13 @@ query = do
  xssi <- xScreenSaverQueryInfo dpy
  closeDisplay dpy
  return $ case xssi of
-    Just XScreenSaverInfo { xssi_state = ScreenSaverDisabled } -> False
+    Just XScreenSaverInfo {xssi_state = ScreenSaverDisabled} -> False
-    Just XScreenSaverInfo { xssi_state = _ }                   -> True
+    Just XScreenSaverInfo {xssi_state = _} -> True
    -- TODO handle errors better (at least log them?)
-    Nothing                                                    -> False
+    Nothing -> False
 --------------------------------------------------------------------------------
-- | DBus Interface
+-- DBus Interface
 --
 -- Define a methods to toggle the screensaver. This methods will emit signal
 -- with the new state when called. Define another method to get the current
@ -81,51 +78,64 @@ sigCurrentState :: Signal
 sigCurrentState = signal ssPath interface memState
 ruleCurrentState :: MatchRule
-ruleCurrentState = matchAny
+ruleCurrentState =
-  { matchPath = Just ssPath
+  matchAny
-  , matchInterface = Just interface
+    { matchPath = Just ssPath
-  , matchMember = Just memState
+    , matchInterface = Just interface
-  }
+    , matchMember = Just memState
    }
 emitState :: Client -> SSState -> IO ()
-emitState client sss = emit client $ sigCurrentState { signalBody = [toVariant sss] }
+emitState client sss = emit client $ sigCurrentState {signalBody = [toVariant sss]}
 bodyGetCurrentState :: [Variant] -> Maybe SSState
 bodyGetCurrentState [b] = fromVariant b :: Maybe SSState
-bodyGetCurrentState _   = Nothing
+bodyGetCurrentState _ = Nothing
 --------------------------------------------------------------------------------
-- | Exported haskell API
+-- Exported haskell API
 exportScreensaver :: Maybe SesClient -> SometimesIO
 exportScreensaver ses =
  sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) cmd
  where
-    cmd cl = let cl' = toClient cl in
+    cmd cl =
-      liftIO $ export cl' ssPath defaultInterface
+      let cl' = toClient cl
-      { interfaceName = interface
+       in liftIO $
-      , interfaceMethods =
+            export
-        [ autoMethod memToggle $ emitState cl' =<< toggle
+              cl'
-        , autoMethod memQuery query
+              ssPath
-        ]
+              defaultInterface
-      , interfaceSignals = [sig]
+                { interfaceName = interface
-      }
+                , interfaceMethods =
-    sig = I.Signal
+                    [ autoMethod memToggle $ emitState cl' =<< toggle
-      { I.signalName = memState
+                    , autoMethod memQuery query
-      , I.signalArgs =
+                    ]
-        [
+                , interfaceSignals = [sig]
-          I.SignalArg
+                }
-          { I.signalArgName = "enabled"
+    sig =
-          , I.signalArgType = TypeBoolean
+      I.Signal
-          }
+        { I.signalName = memState
-        ]
+        , I.signalArgs =
-      }
+            [ I.SignalArg
                { I.signalArgName = "enabled"
                , I.signalArgType = TypeBoolean
                }
            ]
        }
    bus = Bus [] xmonadBusName
    ssx = DBusIO $ sysExe [Package Official "xorg-xset"] ssExecutable
 callToggle :: Maybe SesClient -> SometimesX
-callToggle = sometimesEndpoint "screensaver toggle" "dbus switch" []
+callToggle =
-  xmonadBusName ssPath interface memToggle
+  sometimesEndpoint
    "screensaver toggle"
    "dbus switch"
    []
    xmonadBusName
    ssPath
    interface
    memToggle
 callQuery :: SesClient -> IO (Maybe SSState)
 callQuery ses = do
@ -133,8 +143,12 @@ callQuery ses = do
  return $ either (const Nothing) bodyGetCurrentState reply
 matchSignal :: (Maybe SSState -> IO ()) -> SesClient -> IO ()
-matchSignal cb ses = void $ addMatchCallback ruleCurrentState
+matchSignal cb ses =
-  (cb . bodyGetCurrentState) ses
+  void $
    addMatchCallback
      ruleCurrentState
      (cb . bodyGetCurrentState)
      ses
 ssSignalDep :: DBusDependency_ SesClient
 ssSignalDep = Endpoint [] xmonadBusName ssPath interface $ Signal_ memState
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE ViewPatterns #-}
 --------------------------------------------------------------------------------
-- | Random IO-ish functions used throughtout xmonad
+-- Random IO-ish functions used throughtout xmonad
 --
 -- Most (probably all) of these functions are intended to work with sysfs where
 -- some safe assumptions can be made about file contents.
@ -19,32 +19,31 @@ module XMonad.Internal.IO
  , incPercent
  -- , isReadable
  -- , isWritable
-  , PermResult(..)
+  , PermResult (..)
  , getPermissionsSafe
  , waitUntilExit
-  ) where
+  )
 where
-import           Data.Char
+import Data.Char
-import           Data.Text       (pack, unpack)
+import Data.Text (pack, unpack)
-import           Data.Text.IO    as T (readFile, writeFile)
+import Data.Text.IO as T (readFile, writeFile)
-
+import RIO
-import           RIO
+import RIO.Directory
-import           RIO.Directory
+import RIO.FilePath
-import           RIO.FilePath
+import System.IO.Error
 import           System.IO.Error
 --------------------------------------------------------------------------------
-- | read
+-- read
 readInt :: (Read a, Integral a) => FilePath -> IO a
 readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile
 readBool :: FilePath -> IO Bool
-readBool = fmap (==(1 :: Int)) . readInt
+readBool = fmap (== (1 :: Int)) . readInt
 --------------------------------------------------------------------------------
-- | write
+-- write
 writeInt :: (Show a, Integral a) => FilePath -> a -> IO ()
 writeInt f = T.writeFile f . pack . show
@ -53,16 +52,16 @@ writeBool :: FilePath -> Bool -> IO ()
 writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
 --------------------------------------------------------------------------------
-- | percent-based read/write
+-- percent-based read/write
 --
 -- "Raw" values are whatever is stored in sysfs and "percent" is the user-facing
 -- value. Assume that the file being read has a min of 0 and an unchanging max
 -- given by a runtime argument, which is scaled linearly to the range 0-100
 -- (percent).
 rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => (a, a) -> b -> c
 rawToPercent (lower, upper) raw =
  100 * (fromIntegral raw - fromIntegral lower) / fromIntegral (upper - lower)
 -- rawToPercent upper raw = 100 * fromIntegral raw / fromIntegral upper
 readPercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
@ -71,12 +70,14 @@ readPercent bounds path = do
  return $ rawToPercent bounds (i :: Integer)
 percentToRaw :: (Integral a, RealFrac b, Integral c) => (a, a) -> b -> c
-percentToRaw (lower, upper) perc = round $
+percentToRaw (lower, upper) perc =
-  fromIntegral lower + perc / 100.0 * (fromIntegral upper - fromIntegral lower)
+  round $
    fromIntegral lower + perc / 100.0 * (fromIntegral upper - fromIntegral lower)
 writePercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> b -> IO b
 writePercent bounds path perc = do
-  let t | perc > 100 = 100
+  let t
        | perc > 100 = 100
        | perc < 0 = 0
        | otherwise = perc
  writeInt path (percentToRaw bounds t :: Int)
@ -88,9 +89,15 @@ writePercentMin bounds path = writePercent bounds path 0
 writePercentMax :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
 writePercentMax bounds path = writePercent bounds path 100
-shiftPercent :: (Integral a, RealFrac b) => (b -> b -> b) -> Int -> FilePath
+shiftPercent
-  -> (a, a) -> IO b
+  :: (Integral a, RealFrac b)
-shiftPercent f steps path bounds = writePercent bounds path . f stepsize
+  => (b -> b -> b)
  -> Int
  -> FilePath
  -> (a, a)
  -> IO b
 shiftPercent f steps path bounds =
  writePercent bounds path . f stepsize
    =<< readPercent bounds path
  where
    stepsize = 100 / fromIntegral steps
@ -102,7 +109,7 @@ decPercent :: (Integral a, RealFrac b) => Int -> FilePath -> (a, a) -> IO b
 decPercent = shiftPercent subtract -- silly (-) operator thingy error
 --------------------------------------------------------------------------------
-- | permission query
+-- permission query
 data PermResult a = PermResult a | NotFoundError | PermError
  deriving (Show, Eq)
@ -116,12 +123,12 @@ getPermissionsSafe :: FilePath -> IO (PermResult Permissions)
 getPermissionsSafe f = do
  r <- tryIOError $ getPermissions f
  return $ case r of
-    Right z                            -> PermResult z
+    Right z -> PermResult z
-    Left (isPermissionError -> True)   -> PermError
+    Left (isPermissionError -> True) -> PermError
    Left (isDoesNotExistError -> True) -> NotFoundError
    -- the above error should be the only ones thrown by getPermission,
    -- so the catchall case should never happen
-    _                                  -> error "Unknown permission error"
+    _ -> error "Unknown permission error"
 -- isReadable :: FilePath -> IO (PermResult Bool)
 -- isReadable = fmap (fmap readable) . getPermissionsSafe
--- a/lib/XMonad/Internal/Notify.hs
+++ b/lib/XMonad/Internal/Notify.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Functions for formatting and sending notifications
+-- Functions for formatting and sending notifications
 --
 -- NOTE I use the DBus.Notify lib even though I don't actually use the DBus for
 -- notifications (just formation them into 'notify-send' commands and spawn a
@ -9,42 +9,45 @@
 -- decide to switch to using the DBus it will be easy.
 module XMonad.Internal.Notify
-  ( Note(..)
+  ( Note (..)
-  , Body(..)
+  , Body (..)
  , defNote
  , defNoteInfo
  , defNoteError
  , fmtNotifyCmd
  , spawnNotify
-  ) where
+  )
 where
-import           DBus.Notify
+import DBus.Notify
-
+import RIO
-import           RIO
+import qualified RIO.Text as T
-import qualified RIO.Text              as T
+import XMonad.Internal.Shell
 import           XMonad.Internal.Shell
 --------------------------------------------------------------------------------
-- | Some nice default notes
+-- Some nice default notes
 defNote :: Note
-defNote = blankNote { summary = "\"xmonad\"" }
+defNote = blankNote {summary = "\"xmonad\""}
 defNoteInfo :: Note
-defNoteInfo = defNote
+defNoteInfo =
-  { appImage = Just $ Icon "dialog-information-symbolic" }
+  defNote
    { appImage = Just $ Icon "dialog-information-symbolic"
    }
 defNoteError :: Note
-defNoteError = defNote
+defNoteError =
-  { appImage = Just $ Icon "dialog-error-symbolic" }
+  defNote
    { appImage = Just $ Icon "dialog-error-symbolic"
    }
 --------------------------------------------------------------------------------
-- | Format a 'notify-send' command to be send to the shell
+-- Format a 'notify-send' command to be send to the shell
 parseBody :: Body -> Maybe T.Text
 parseBody (Text s) = Just $ T.pack s
-parseBody _        = Nothing
+parseBody _ = Nothing
 fmtNotifyCmd :: Note -> T.Text
 fmtNotifyCmd = fmtCmd "notify-send" . fmtNotifyArgs
@ -56,8 +59,8 @@ fmtNotifyArgs :: Note -> [T.Text]
 fmtNotifyArgs n = getIcon n ++ getSummary n ++ getBody n
  where
    -- TODO add the rest of the options as needed
-    getSummary = (:[]) . doubleQuote . T.pack . summary
+    getSummary = (: []) . doubleQuote . T.pack . summary
    getIcon n' =
-      maybe [] (\i -> ["-i", T.pack $ case i of { Icon s -> s; File s -> s }])
+      maybe [] (\i -> ["-i", T.pack $ case i of Icon s -> s; File s -> s]) $
-      $ appImage n'
+        appImage n'
    getBody n' = maybeToList $ (fmap doubleQuote . parseBody) =<< body n'
--- a/lib/XMonad/Internal/Process.hs
+++ b/lib/XMonad/Internal/Process.hs
@ -1,17 +0,0 @@
 --------------------------------------------------------------------------------
 -- | Functions for managing processes
 module XMonad.Internal.Process where
 -- import           Control.Exception
 -- import           Control.Monad
 -- import           Control.Monad.IO.Class
 -- import qualified RIO.Text               as T
 -- import           System.Exit
 -- import           System.IO
 -- import           System.Process
 -- import           XMonad.Core            hiding (spawn)
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@ -1,58 +1,7 @@
 -- | Functions for formatting and spawning shell commands
 --
 -- TLDR: spawning a "command" in xmonad is complicated for weird reasons, and
 -- this solution is the most sane (for me) given the constraints of the xmonad
 -- codebase.
 --
 -- A few facts about xmonad (and window managers in general):
 -- 1) It is single-threaded (since X is single threaded)
 -- 2) Because of (1), it ignores SIGCHLD, which means any subprocess started
 --    by xmonad will instantly be reaped after spawning. This guarantees the
 --    main thread running the WM will never be blocked.
 --
 -- In general, this means that 'System.Process.waitForProcess' (and similar)
 -- will not work since these call wait() on the child process, which will fail
 -- because the child has already been cleared and thus there is nothing on which
 -- to wait. By extension this also means we don't have access to a child's exit
 -- code.
 --
 -- XMonad and contrib use their own method of spawning subprocesses using the
 -- extremely low-level 'System.Process.Posix' API. See the code for
 -- 'XMonad.Core.spawn' or 'XMonad.Util.Run.safeSpawn'. Specifically, the
 -- sequence is (in terms of the low level Linux API):
 -- 1) call fork()
 -- 2) uninstall signal handlers
 -- 3) call setsid()
 -- 4) start new thing with exec()
 --
 -- In practice, I'm guessing the main reason for 2 and 3 is so that child
 -- processes don't inherit the weird SIGCHLD behavior of xmonad itself. The
 -- setsid thing is one way to guarantee that killing the child thread will also
 -- kill its children (if any). Note that this obviously will not block since
 -- we are calling fork() without wait() (which would throw an error anyways).
 --
 -- What if I actually want the exit code?
 --
 -- The best solution (I can come up with), is to use bracket to uninstall
 -- handlers, run process (with wait), and then reinstall handlers. I can use
 -- this with a much higher-level interface which will make things easier. This
 -- obviously means that if the process is running in the main thread, it needs
 -- to be almost instantaneous (since it actually will be blocking). NOTE: I
 -- shouldn't use this to replace the existing functions in xmonad since
 -- 'spawning' a new process in a non-blocking manner with a higher-level API
 -- will produce lots of Haskell objects that need to be cleaned, and it will be
 -- hard (perhaps impossible) to keep track and deal with these after spawning.
 --
 -- This works, albeit with the cost of using almost every process API in Haskell.
 --
 -- Briefly:
 -- 1) 'System.Process.Posix' (where xmonad lives)
 -- 2) 'System.Process' (wraps 1)
 -- 2) 'System.Process.Typed' (wraps 2, which I prefer for getting exit codes)
 -- 3) 'RIO.Process' (wraps 3, which I prefer at the app level)
 {-# LANGUAGE OverloadedStrings #-}
 -- Functions for formatting and spawning shell commands
 module XMonad.Internal.Shell
  ( fmtCmd
  , spawnCmd
@ -68,80 +17,117 @@ module XMonad.Internal.Shell
  , (#!||)
  , (#!|)
  , (#!>>)
-  ) where
+  )
-
+where
 import           RIO
 import qualified RIO.Text             as T
 import RIO
 import qualified RIO.Text as T
 import qualified System.Process.Typed as P
 import qualified XMonad.Core as X
 import qualified XMonad.Util.Run as XR
-import qualified XMonad.Core          as X
+-- | Fork a new process and wait for its exit code.
-import qualified XMonad.Util.Run      as XR
+--
-
+-- This function will work despite xmonad ignoring SIGCHLD.
--------------------------------------------------------------------------------
+--
-- | Opening subshell
+-- A few facts about xmonad (and window managers in general):
-- https://github.com/xmonad/xmonad/issues/113
+-- 1) It is single-threaded (since X is single threaded)
 -- 2) Because of (1), it ignores SIGCHLD, which means any subprocess started
 --    by xmonad will instantly be reaped after spawning. This guarantees the
 --    main thread running the WM will never be blocked.
 --
 -- In general, this means I can't wait for exit codes (since wait() doesn't
 -- work) See https://github.com/xmonad/xmonad/issues/113.
 --
 -- If I want an exit code, The best solution (I can come up with), is to use
 -- bracket to uninstall handlers, run process (with wait), and then reinstall
 -- handlers. I can use this with a much higher-level interface which will make
 -- things easier. This obviously means that if the process is running in the
 -- main thread, it needs to be almost instantaneous. Note if using a high-level
 -- API for this, the process needs to spawn, finish, and be reaped by the
 -- xmonad process all while the signal handlers are 'disabled' (which limits
 -- the functions I can use to those that call waitForProcess).
 --
 -- XMonad and contrib use their own method of spawning subprocesses using the
 -- extremely low-level 'System.Process.Posix' API. See the code for
 -- 'XMonad.Core.spawn' or 'XMonad.Util.Run.safeSpawn'. Specifically, the
 -- sequence is (in terms of the low level Linux API):
 -- 1) call fork()
 -- 2) uninstall signal handlers (to allow wait() to work in subprocesses)
 -- 3) call setsid() (so killing the child will kill its children, if any)
 -- 4) start new thing with exec()
 --
 -- In contrast with high-level APIs like 'System.Process', this will leave no
 -- trailing data structures to clean up, at the cost of being gross to look at
 -- and possibly more error-prone.
 runProcess :: P.ProcessConfig a b c -> IO ExitCode
 runProcess = withDefaultSignalHandlers . P.runProcess
 -- | Run an action without xmonad's signal handlers.
 withDefaultSignalHandlers :: IO a -> IO a
 withDefaultSignalHandlers =
  bracket_ X.uninstallSignalHandlers X.installSignalHandlers
 -- | Set a child process to create a new group and session
 addGroupSession :: P.ProcessConfig x y z -> P.ProcessConfig x y z
 addGroupSession = P.setCreateGroup True . P.setNewSession True
-runProcess :: P.ProcessConfig a b c -> IO ExitCode
+-- | Create a 'ProcessConfig' for a shell command
 runProcess = withDefaultSignalHandlers . P.runProcess
 shell :: T.Text -> P.ProcessConfig () () ()
 shell = addGroupSession . P.shell . T.unpack
 -- | Create a 'ProcessConfig' for a command with arguments
 proc :: FilePath -> [T.Text] -> P.ProcessConfig () () ()
 proc cmd args = addGroupSession $ P.proc cmd (T.unpack <$> args)
 -- | Run 'XMonad.Core.spawn' with 'Text' input.
 spawn :: MonadIO m => T.Text -> m ()
 spawn = X.spawn . T.unpack
-- spawnAt :: MonadIO m => FilePath -> T.Text -> m ()
+-- | Run 'XMonad.Run.Utils.spawnPipe' with 'Text' input.
 -- spawnAt fp = liftIO . void . startProcess . P.setWorkingDir fp . shell
 spawnPipe :: MonadIO m => T.Text -> m Handle
 spawnPipe = XR.spawnPipe . T.unpack
 -- | Run 'XMonad.Core.spawn' with a command and arguments
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
 spawnCmd cmd = spawn . fmtCmd cmd
--------------------------------------------------------------------------------
+-- | Format a command and list of arguments as 'Text'
 -- | Formatting commands
 fmtCmd :: FilePath -> [T.Text] -> T.Text
 fmtCmd cmd args = T.unwords $ T.pack cmd : args
 op :: T.Text -> T.Text -> T.Text -> T.Text
 op a x b = T.unwords [a, x, b]
 -- | Format two shell expressions separated by "&&"
 (#!&&) :: T.Text -> T.Text -> T.Text
 cmdA #!&& cmdB = op cmdA "&&" cmdB
 infixr 0 #!&&
 -- | Format two shell expressions separated by "|"
 (#!|) :: T.Text -> T.Text -> T.Text
 cmdA #!| cmdB = op cmdA "|" cmdB
 infixr 0 #!|
 -- | Format two shell expressions separated by "||"
 (#!||) :: T.Text -> T.Text -> T.Text
 cmdA #!|| cmdB = op cmdA "||" cmdB
 infixr 0 #!||
 -- | Format two shell expressions separated by ";"
 (#!>>) :: T.Text -> T.Text -> T.Text
 cmdA #!>> cmdB = op cmdA ";" cmdB
 infixr 0 #!>>
 -- | Wrap input in double quotes
 doubleQuote :: T.Text -> T.Text
 doubleQuote s = T.concat ["\"", s, "\""]
 -- | Wrap input in single quotes
 singleQuote :: T.Text -> T.Text
 singleQuote s = T.concat ["'", s, "'"]
--- a/lib/XMonad/Internal/Theme.hs
+++ b/lib/XMonad/Internal/Theme.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Theme for XMonad and Xmobar
+-- Theme for XMonad and Xmobar
 module XMonad.Internal.Theme
  ( baseColor
@ -18,9 +18,9 @@ module XMonad.Internal.Theme
  , backdropTextColor
  , blend'
  , darken'
-  , Slant(..)
+  , Slant (..)
-  , Weight(..)
+  , Weight (..)
-  , FontData(..)
+  , FontData (..)
  , FontBuilder
  , buildFont
  , fallbackFont
@ -28,18 +28,17 @@ module XMonad.Internal.Theme
  , defFontData
  , tabbedTheme
  , promptTheme
-  ) where
+  )
-
+where
 import           Data.Colour
 import           Data.Colour.SRGB
 import qualified RIO.Text                 as T
 import Data.Colour
 import Data.Colour.SRGB
 import qualified RIO.Text as T
 import qualified XMonad.Layout.Decoration as D
-import qualified XMonad.Prompt            as P
+import qualified XMonad.Prompt as P
 --------------------------------------------------------------------------------
-- | Colors - vocabulary roughly based on GTK themes
+-- Colors - vocabulary roughly based on GTK themes
 baseColor :: T.Text
 baseColor = "#f7f7f7"
@ -78,7 +77,7 @@ backdropFgColor :: T.Text
 backdropFgColor = blend' 0.75 fgColor bgColor
 --------------------------------------------------------------------------------
-- | Color functions
+-- Color functions
 blend' :: Float -> T.Text -> T.Text -> T.Text
 blend' wt c0 c1 = sRGB24showT $ blend wt (sRGB24readT c0) (sRGB24readT c1)
@ -93,64 +92,73 @@ sRGB24showT :: (RealFrac a, Floating a) => Colour a -> T.Text
 sRGB24showT = T.pack . sRGB24show
 --------------------------------------------------------------------------------
-- | Fonts
+-- Fonts
-data Slant = Roman
+data Slant
-    | Italic
+  = Roman
-    | Oblique
+  | Italic
-    deriving (Eq, Show)
+  | Oblique
  deriving (Eq, Show)
-data Weight = Light
+data Weight
-    | Medium
+  = Light
-    | Demibold
+  | Medium
-    | Bold
+  | Demibold
-    | Black
+  | Bold
-    deriving (Eq, Show)
+  | Black
  deriving (Eq, Show)
 data FontData = FontData
-    { weight    :: Maybe Weight
+  { weight :: Maybe Weight
-    , slant     :: Maybe Slant
+  , slant :: Maybe Slant
-    , size      :: Maybe Int
+  , size :: Maybe Int
-    , pixelsize :: Maybe Int
+  , pixelsize :: Maybe Int
-    , antialias :: Maybe Bool
+  , antialias :: Maybe Bool
-    }
+  }
 type FontBuilder = FontData -> T.Text
 buildFont :: Maybe T.Text -> FontData -> T.Text
 buildFont Nothing _ = "fixed"
-buildFont (Just fam) FontData { weight = w
+buildFont
-                            , slant = l
+  (Just fam)
-                            , size = s
+  FontData
-                            , pixelsize = p
+    { weight = w
-                            , antialias = a
+    , slant = l
-                            }
+    , size = s
-  = T.intercalate ":" $ ["xft", fam] ++ elems
+    , pixelsize = p
-  where
+    , antialias = a
-    elems = [ T.concat [k, "=", v] | (k, Just v) <- [ ("weight", showLower w)
+    } =
-                                                    , ("slant", showLower l)
+    T.intercalate ":" $ ["xft", fam] ++ elems
-                                                    , ("size", showLower s)
+    where
-                                                    , ("pixelsize", showLower p)
+      elems =
-                                                    , ("antialias", showLower a)
+        [ T.concat [k, "=", v]
-                                                    ]
+        | (k, Just v) <-
-                            ]
+            [ ("weight", showLower w)
-    showLower :: Show a => Maybe a -> Maybe T.Text
+            , ("slant", showLower l)
-    showLower = fmap (T.toLower . T.pack . show)
+            , ("size", showLower s)
            , ("pixelsize", showLower p)
            , ("antialias", showLower a)
            ]
        ]
      showLower :: Show a => Maybe a -> Maybe T.Text
      showLower = fmap (T.toLower . T.pack . show)
 fallbackFont :: FontBuilder
 fallbackFont = buildFont Nothing
 --------------------------------------------------------------------------------
-- | Default font and data
+-- Default font and data
 defFontData :: FontData
-defFontData = FontData
+defFontData =
-  { size = Just 10
+  FontData
-  , antialias = Just True
+    { size = Just 10
-  , weight = Nothing
+    , antialias = Just True
-  , slant = Nothing
+    , weight = Nothing
-  , pixelsize = Nothing
+    , slant = Nothing
-  }
+    , pixelsize = Nothing
    }
 defFontFamily :: T.Text
 defFontFamily = "DejaVu Sans"
@ -162,44 +170,42 @@ defFontFamily = "DejaVu Sans"
 -- defFontTree = fontTree "DejaVu Sans"
 --------------------------------------------------------------------------------
-- | Complete themes
+-- Complete themes
 tabbedTheme :: FontBuilder -> D.Theme
-tabbedTheme fb = D.def
+tabbedTheme fb =
-  { D.fontName              = T.unpack $ fb $ defFontData { weight = Just Bold }
+  D.def
    { D.fontName = T.unpack $ fb $ defFontData {weight = Just Bold}
    , D.activeTextColor = T.unpack fgColor
    , D.activeColor = T.unpack bgColor
    , D.activeBorderColor = T.unpack bgColor
    , D.inactiveTextColor = T.unpack backdropTextColor
    , D.inactiveColor = T.unpack backdropFgColor
    , D.inactiveBorderColor = T.unpack backdropFgColor
    , D.urgentTextColor = T.unpack $ darken' 0.5 errorColor
    , D.urgentColor = T.unpack errorColor
    , D.urgentBorderColor = T.unpack errorColor
    , -- this is in a newer version
      -- , D.activeBorderWidth     = 0
      -- , D.inactiveBorderWidth   = 0
      -- , D.urgentBorderWidth     = 0
-  , D.activeTextColor       = T.unpack fgColor
+      D.decoHeight = 20
-  , D.activeColor           = T.unpack bgColor
+    , D.windowTitleAddons = []
-  , D.activeBorderColor     = T.unpack bgColor
+    , D.windowTitleIcons = []
-
+    }
  , D.inactiveTextColor     = T.unpack backdropTextColor
  , D.inactiveColor         = T.unpack backdropFgColor
  , D.inactiveBorderColor   = T.unpack backdropFgColor
  , D.urgentTextColor       = T.unpack $ darken' 0.5 errorColor
  , D.urgentColor           = T.unpack errorColor
  , D.urgentBorderColor     = T.unpack errorColor
  -- this is in a newer version
  -- , D.activeBorderWidth     = 0
  -- , D.inactiveBorderWidth   = 0
  -- , D.urgentBorderWidth     = 0
  , D.decoHeight            = 20
  , D.windowTitleAddons     = []
  , D.windowTitleIcons      = []
  }
 promptTheme :: FontBuilder -> P.XPConfig
-promptTheme fb = P.def
+promptTheme fb =
-  { P.font              = T.unpack $ fb $ defFontData { size = Just 12 }
+  P.def
-  , P.bgColor           = T.unpack bgColor
+    { P.font = T.unpack $ fb $ defFontData {size = Just 12}
-  , P.fgColor           = T.unpack fgColor
+    , P.bgColor = T.unpack bgColor
-  , P.fgHLight          = T.unpack selectedFgColor
+    , P.fgColor = T.unpack fgColor
-  , P.bgHLight          = T.unpack selectedBgColor
+    , P.fgHLight = T.unpack selectedFgColor
-  , P.borderColor       = T.unpack bordersColor
+    , P.bgHLight = T.unpack selectedBgColor
-  , P.promptBorderWidth = 1
+    , P.borderColor = T.unpack bordersColor
-  , P.height            = 35
+    , P.promptBorderWidth = 1
-  , P.position          = P.CenteredAt 0.5 0.5
+    , P.height = 35
-  , P.historySize       = 0
+    , P.position = P.CenteredAt 0.5 0.5
-  }
+    , P.historySize = 0
    }
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@ -1,25 +1,26 @@
 {-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
+-- Common backlight plugin bits
 -- | Common backlight plugin bits
 --
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 module Xmobar.Plugins.BacklightCommon (startBacklight) where
-import           Data.Internal.DBus
+import Data.Internal.DBus
 import qualified RIO.Text as T
 import Xmobar.Plugins.Common
-import qualified RIO.Text              as T
+startBacklight
-
+  :: RealFrac a
-import           Xmobar.Plugins.Common
+  => ((Maybe a -> IO ()) -> SesClient -> IO ())
-
+  -> (SesClient -> IO (Maybe a))
-startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ())
+  -> T.Text
-  -> (SesClient -> IO (Maybe a)) -> T.Text -> Callback -> IO ()
+  -> Callback
  -> IO ()
 startBacklight matchSignal callGetBrightness icon cb = do
-    withDBusClientConnection cb $ \c -> do
+  withDBusClientConnection cb $ \c -> do
-      matchSignal display c
+    matchSignal display c
-      display =<< callGetBrightness c
+    display =<< callGetBrightness c
-    where
+  where
-      formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"]
+    formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"]
-      display = displayMaybe cb formatBrightness
+    display = displayMaybe cb formatBrightness
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Bluetooth plugin
+-- Bluetooth plugin
 --
 -- Use the bluez interface on DBus to check status
 --
@ -33,36 +33,34 @@
 -- adapter changing.
 module Xmobar.Plugins.Bluetooth
-  ( Bluetooth(..)
+  ( Bluetooth (..)
  , btAlias
  , btDep
-  ) where
+  )
 where
-import           Control.Concurrent.MVar
+import Control.Concurrent.MVar
-import           Control.Monad
+import Control.Monad
-
+import DBus
-import           Data.Internal.DBus
+import DBus.Client
-import           Data.Internal.Dependency
+import Data.Internal.DBus
-import           Data.List
+import Data.Internal.Dependency
-import           Data.List.Split
+import Data.List
-import qualified Data.Map                    as M
+import Data.List.Split
-import           Data.Maybe
+import qualified Data.Map as M
-
+import Data.Maybe
-import           DBus
+import qualified RIO.Text as T
-import           DBus.Client
+import XMonad.Internal.DBus.Common
-
+import Xmobar
-import qualified RIO.Text                    as T
+import Xmobar.Plugins.Common
 import           XMonad.Internal.DBus.Common
 import           Xmobar
 import           Xmobar.Plugins.Common
 btAlias :: T.Text
 btAlias = "bluetooth"
 btDep :: DBusDependency_ SysClient
-btDep = Endpoint [Package Official "bluez"] btBus btOMPath omInterface
+btDep =
-  $ Method_ getManagedObjects
+  Endpoint [Package Official "bluez"] btBus btOMPath omInterface $
    Method_ getManagedObjects
 data Bluetooth = Bluetooth Icons Colors deriving (Read, Show)
@ -90,7 +88,7 @@ startAdapter is cs cb cl = do
    display
 --------------------------------------------------------------------------------
-- | Icon Display
+-- Icon Display
 --
 -- Color corresponds to the adaptor powered state, and the icon corresponds to
 -- if it is paired or not. If the adaptor state is undefined, display "N/A"
@ -111,7 +109,7 @@ iconFormatter (iconConn, iconDisc) cs powered connected =
    icon = if connected then iconConn else iconDisc
 --------------------------------------------------------------------------------
-- | Connection State
+-- Connection State
 --
 -- The signal handlers all run on separate threads, yet the icon depends on
 -- the state reflected by all these signals. The best (only?) way to do this is
@ -119,7 +117,7 @@ iconFormatter (iconConn, iconDisc) cs powered connected =
 -- an MVar.
 data BTDevice = BTDevice
-  { btDevConnected  :: Maybe Bool
+  { btDevConnected :: Maybe Bool
  , btDevSigHandler :: SignalHandler
  }
@ -133,10 +131,11 @@ data BtState = BtState
 type MutableBtState = MVar BtState
 emptyState :: BtState
-emptyState = BtState
+emptyState =
-  { btDevices = M.empty
+  BtState
-  , btPowered = Nothing
+    { btDevices = M.empty
-  }
+    , btPowered = Nothing
    }
 readState :: MutableBtState -> IO (Maybe Bool, Bool)
 readState state = do
@ -145,7 +144,7 @@ readState state = do
  return (p, anyDevicesConnected c)
 --------------------------------------------------------------------------------
-- | Object manager
+-- Object manager
 findAdapter :: ObjectTree -> Maybe ObjectPath
 findAdapter = find (("/org/bluez/hci" `isPrefixOf`) . formatObjectPath) . M.keys
@ -156,10 +155,10 @@ findDevices adapter = filter (adaptorHasDevice adapter) . M.keys
 adaptorHasDevice :: ObjectPath -> ObjectPath -> Bool
 adaptorHasDevice adaptor device = case splitPath device of
  [org, bluez, hciX, _] -> splitPath adaptor == [org, bluez, hciX]
-  _                     -> False
+  _ -> False
 splitPath :: ObjectPath -> [T.Text]
-splitPath = fmap T.pack . splitOn "/" . dropWhile (=='/') . formatObjectPath
+splitPath = fmap T.pack . splitOn "/" . dropWhile (== '/') . formatObjectPath
 getBtObjectTree :: SysClient -> IO ObjectTree
 getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
@ -191,7 +190,7 @@ pathCallback adapter display f [device, _] = forM_ (fromVariant device) $ \d ->
 pathCallback _ _ _ _ = return ()
 --------------------------------------------------------------------------------
-- | Adapter
+-- Adapter
 initAdapter :: MutableBtState -> ObjectPath -> SysClient -> IO ()
 initAdapter state adapter client = do
@ -201,7 +200,11 @@ initAdapter state adapter client = do
 matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule)
 matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
-addAdaptorListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
+addAdaptorListener
  :: MutableBtState
  -> IO ()
  -> ObjectPath
  -> SysClient
  -> IO (Maybe SignalHandler)
 addAdaptorListener state display adaptor sys = do
  rule <- matchBTProperty sys adaptor
@ -210,14 +213,16 @@ addAdaptorListener state display adaptor sys = do
    procMatch = withSignalMatch $ \b -> putPowered state b >> display
 callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
-callGetPowered adapter = callPropertyGet btBus adapter adapterInterface
+callGetPowered adapter =
-  $ memberName_ $ T.unpack adaptorPowered
+  callPropertyGet btBus adapter adapterInterface $
    memberName_ $
      T.unpack adaptorPowered
 matchPowered :: [Variant] -> SignalMatch Bool
 matchPowered = matchPropertyChanged adapterInterface adaptorPowered
 putPowered :: MutableBtState -> Maybe Bool -> IO ()
-putPowered m ds = modifyMVar_ m (\s -> return s { btPowered = ds })
+putPowered m ds = modifyMVar_ m (\s -> return s {btPowered = ds})
 readPowered :: MutableBtState -> IO (Maybe Bool)
 readPowered = fmap btPowered . readMVar
@ -229,7 +234,7 @@ adaptorPowered :: T.Text
 adaptorPowered = "Powered"
 --------------------------------------------------------------------------------
-- | Devices
+-- Devices
 addAndInitDevice :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
 addAndInitDevice state display device client = do
@ -240,12 +245,18 @@ addAndInitDevice state display device client = do
 initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO ()
 initDevice state sh device sys = do
  reply <- callGetConnected device sys
-  void $ insertDevice state device $
+  void $
-    BTDevice { btDevConnected = fromVariant =<< listToMaybe reply
+    insertDevice state device $
-             , btDevSigHandler = sh
+      BTDevice
-             }
+        { btDevConnected = fromVariant =<< listToMaybe reply
        , btDevSigHandler = sh
        }
-addDeviceListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
+addDeviceListener
  :: MutableBtState
  -> IO ()
  -> ObjectPath
  -> SysClient
  -> IO (Maybe SignalHandler)
 addDeviceListener state display device sys = do
  rule <- matchBTProperty sys device
@ -257,18 +268,19 @@ matchConnected :: [Variant] -> SignalMatch Bool
 matchConnected = matchPropertyChanged devInterface devConnected
 callGetConnected :: ObjectPath -> SysClient -> IO [Variant]
-callGetConnected p = callPropertyGet btBus p devInterface
+callGetConnected p =
-  $ memberName_ (T.unpack devConnected)
+  callPropertyGet btBus p devInterface $
    memberName_ (T.unpack devConnected)
 insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool
 insertDevice m device dev = modifyMVar m $ \s -> do
  let new = M.insert device dev $ btDevices s
-  return (s { btDevices = new }, anyDevicesConnected new)
+  return (s {btDevices = new}, anyDevicesConnected new)
 updateDevice :: MutableBtState -> ObjectPath -> Maybe Bool -> IO Bool
 updateDevice m device status = modifyMVar m $ \s -> do
-  let new = M.update (\d -> Just d { btDevConnected = status }) device $ btDevices s
+  let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s
-  return (s { btDevices = new }, anyDevicesConnected new)
+  return (s {btDevices = new}, anyDevicesConnected new)
 anyDevicesConnected :: ConnectedDevices -> Bool
 anyDevicesConnected = or . mapMaybe btDevConnected . M.elems
@ -276,7 +288,7 @@ anyDevicesConnected = or . mapMaybe btDevConnected . M.elems
 removeDevice :: MutableBtState -> ObjectPath -> IO (Maybe BTDevice)
 removeDevice m device = modifyMVar m $ \s -> do
  let devs = btDevices s
-  return (s { btDevices = M.delete device devs }, M.lookup device devs)
+  return (s {btDevices = M.delete device devs}, M.lookup device devs)
 readDevices :: MutableBtState -> IO ConnectedDevices
 readDevices = fmap btDevices . readMVar
--- a/lib/Xmobar/Plugins/ClevoKeyboard.hs
+++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs
@ -1,23 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Clevo Keyboard plugin
+-- Clevo Keyboard plugin
 --
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 module Xmobar.Plugins.ClevoKeyboard
-  ( ClevoKeyboard(..)
+  ( ClevoKeyboard (..)
  , ckAlias
-  ) where
+  )
 where
-import qualified RIO.Text                                      as T
+import qualified RIO.Text as T
-
+import XMonad.Internal.DBus.Brightness.ClevoKeyboard
-import           Xmobar
+import Xmobar
-
+import Xmobar.Plugins.BacklightCommon
 import           Xmobar.Plugins.BacklightCommon
 import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
 newtype ClevoKeyboard = ClevoKeyboard T.Text deriving (Read, Show)
@ -27,4 +25,4 @@ ckAlias = "clevokeyboard"
 instance Exec ClevoKeyboard where
  alias (ClevoKeyboard _) = T.unpack ckAlias
  start (ClevoKeyboard icon) =
-     startBacklight matchSignalCK callGetBrightnessCK icon
+    startBacklight matchSignalCK callGetBrightnessCK icon
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@ -8,36 +8,38 @@ module Xmobar.Plugins.Common
  , fromSingletonVariant
  , withDBusClientConnection
  , Callback
-  , Colors(..)
+  , Colors (..)
  , displayMaybe
  , displayMaybe'
  , xmobarFGColor
  )
-  where
+where
-import           Control.Monad
+import Control.Monad
-
+import DBus
-import           Data.Internal.DBus
+import DBus.Client
-
+import Data.Internal.DBus
-import           DBus
+import qualified RIO.Text as T
-import           DBus.Client
+import XMonad.Hooks.DynamicLog (xmobarColor)
 import qualified RIO.Text                as T
 import           XMonad.Hooks.DynamicLog (xmobarColor)
 -- use string here since all the callbacks in xmobar use strings :(
 type Callback = String -> IO ()
 data Colors = Colors
-  { colorsOn  :: T.Text
+  { colorsOn :: T.Text
  , colorsOff :: T.Text
  }
  deriving (Eq, Show, Read)
-startListener :: (SafeClient c, IsVariant a) => MatchRule -> (c -> IO [Variant])
+startListener
-  -> ([Variant] -> SignalMatch a) -> (a -> IO T.Text) -> Callback
+  :: (SafeClient c, IsVariant a)
-  -> c -> IO ()
+  => MatchRule
  -> (c -> IO [Variant])
  -> ([Variant] -> SignalMatch a)
  -> (a -> IO T.Text)
  -> Callback
  -> c
  -> IO ()
 startListener rule getProp fromSignal toColor cb client = do
  reply <- getProp client
  displayMaybe cb toColor $ fromSingletonVariant reply
@ -49,8 +51,8 @@ procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO ()
 procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
 colorText :: Colors -> Bool -> T.Text -> T.Text
-colorText Colors { colorsOn = c } True   = xmobarFGColor c
+colorText Colors {colorsOn = c} True = xmobarFGColor c
-colorText Colors { colorsOff = c } False = xmobarFGColor c
+colorText Colors {colorsOff = c} False = xmobarFGColor c
 xmobarFGColor :: T.Text -> T.Text -> T.Text
 xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@ -1,30 +1,27 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Device plugin
+-- Device plugin
 --
 -- Display different text depending on whether or not the interface has
 -- connectivity
 module Xmobar.Plugins.Device
-  ( Device(..)
+  ( Device (..)
  , devDep
-  ) where
+  )
 where
-import           Control.Monad
+import Control.Monad
-
+import DBus
-import           Data.Internal.DBus
+import Data.Internal.DBus
-import           Data.Internal.Dependency
+import Data.Internal.Dependency
-import           Data.Word
+import Data.Word
-
+import qualified RIO.Text as T
-import           DBus
+import XMonad.Internal.Command.Desktop
-
+import XMonad.Internal.DBus.Common
-import qualified RIO.Text                        as T
+import Xmobar
-
+import Xmobar.Plugins.Common
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.DBus.Common
 import           Xmobar
 import           Xmobar.Plugins.Common
 newtype Device = Device (T.Text, T.Text, Colors) deriving (Read, Show)
@ -44,19 +41,23 @@ devSignal :: T.Text
 devSignal = "Ip4Connectivity"
 devDep :: DBusDependency_ SysClient
-devDep = Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface
+devDep =
-  $ Method_ getByIP
+  Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
    Method_ getByIP
 getDevice :: SysClient -> T.Text -> IO (Maybe ObjectPath)
 getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
  where
-    mc = (methodCallBus networkManagerBus nmPath nmInterface getByIP)
+    mc =
-      { methodCallBody = [toVariant iface]
+      (methodCallBus networkManagerBus nmPath nmInterface getByIP)
-      }
+        { methodCallBody = [toVariant iface]
        }
 getDeviceConnected :: ObjectPath -> SysClient -> IO [Variant]
-getDeviceConnected path = callPropertyGet networkManagerBus path nmDeviceInterface
+getDeviceConnected path =
-  $ memberName_ $ T.unpack devSignal
+  callPropertyGet networkManagerBus path nmDeviceInterface $
    memberName_ $
      T.unpack devSignal
 matchStatus :: [Variant] -> SignalMatch Word32
 matchStatus = matchPropertyChanged nmDeviceInterface devSignal
--- a/lib/Xmobar/Plugins/IntelBacklight.hs
+++ b/lib/Xmobar/Plugins/IntelBacklight.hs
@ -1,23 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Intel backlight plugin
+-- Intel backlight plugin
 --
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 module Xmobar.Plugins.IntelBacklight
-  ( IntelBacklight(..)
+  ( IntelBacklight (..)
  , blAlias
-  ) where
+  )
 where
-import qualified RIO.Text                                       as T
+import qualified RIO.Text as T
-
+import XMonad.Internal.DBus.Brightness.IntelBacklight
-import           Xmobar
+import Xmobar
-
+import Xmobar.Plugins.BacklightCommon
 import           Xmobar.Plugins.BacklightCommon
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
 newtype IntelBacklight = IntelBacklight T.Text deriving (Read, Show)
@ -27,4 +25,4 @@ blAlias = "intelbacklight"
 instance Exec IntelBacklight where
  alias (IntelBacklight _) = T.unpack blAlias
  start (IntelBacklight icon) =
-     startBacklight matchSignalIB callGetBrightnessIB icon
+    startBacklight matchSignalIB callGetBrightnessIB icon
--- a/lib/Xmobar/Plugins/Screensaver.hs
+++ b/lib/Xmobar/Plugins/Screensaver.hs
@ -1,22 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Screensaver plugin
+-- Screensaver plugin
 --
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 module Xmobar.Plugins.Screensaver
-  ( Screensaver(..)
+  ( Screensaver (..)
  , ssAlias
-  ) where
+  )
 where
-import qualified RIO.Text                         as T
+import qualified RIO.Text as T
-
+import XMonad.Internal.DBus.Screensaver
-import           Xmobar
+import Xmobar
-
+import Xmobar.Plugins.Common
 import           XMonad.Internal.DBus.Screensaver
 import           Xmobar.Plugins.Common
 newtype Screensaver = Screensaver (T.Text, Colors) deriving (Read, Show)
@ -31,4 +30,3 @@ instance Exec Screensaver where
      display =<< callQuery sys
    where
      display = displayMaybe cb $ return . (\s -> colorText colors s text)
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@ -1,35 +1,32 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | VPN plugin
+-- VPN plugin
 --
 -- Use the networkmanager to detect when a VPN interface is added or removed.
 -- Specifically, monitor the object tree to detect paths with the interface
 -- "org.freedesktop.NetworkManager.Device.Tun".
 module Xmobar.Plugins.VPN
-  ( VPN(..)
+  ( VPN (..)
  , vpnAlias
  , vpnDep
-  ) where
+  )
 where
-import           Control.Concurrent.MVar
+import Control.Concurrent.MVar
-import           Control.Monad
+import Control.Monad
-
+import DBus
-import           Data.Internal.DBus
+import Data.Internal.DBus
-import           Data.Internal.Dependency
+import Data.Internal.Dependency
-import qualified Data.Map                        as M
+import qualified Data.Map as M
-import           Data.Maybe
+import Data.Maybe
-import qualified Data.Set                        as S
+import qualified Data.Set as S
-
+import qualified RIO.Text as T
-import           DBus
+import XMonad.Internal.Command.Desktop
-
+import XMonad.Internal.DBus.Common
-import qualified RIO.Text                        as T
+import Xmobar
-
+import Xmobar.Plugins.Common
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.DBus.Common
 import           Xmobar
 import           Xmobar.Plugins.Common
 newtype VPN = VPN (T.Text, Colors) deriving (Read, Show)
@ -37,17 +34,17 @@ instance Exec VPN where
  alias (VPN _) = T.unpack vpnAlias
  start (VPN (text, colors)) cb =
    withDBusClientConnection cb $ \c -> do
-    state <- initState c
+      state <- initState c
-    let display = displayMaybe cb iconFormatter . Just =<< readState state
+      let display = displayMaybe cb iconFormatter . Just =<< readState state
-    let signalCallback' f = f state display
+      let signalCallback' f = f state display
-    vpnAddedListener (signalCallback' addedCallback) c
+      vpnAddedListener (signalCallback' addedCallback) c
-    vpnRemovedListener (signalCallback' removedCallback) c
+      vpnRemovedListener (signalCallback' removedCallback) c
-    display
+      display
    where
      iconFormatter b = return $ colorText colors b text
 --------------------------------------------------------------------------------
-- | VPN State
+-- VPN State
 --
 -- Maintain a set of paths which are the currently active VPNs. Most of the time
 -- this will be a null or singleton set, but this setup could handle the edge
@ -65,13 +62,15 @@ initState client = do
 readState :: MutableVPNState -> IO Bool
 readState = fmap (not . null) . readMVar
-updateState :: (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
+updateState
-  -> ObjectPath -> IO ()
+  :: (ObjectPath -> VPNState -> VPNState)
  -> MutableVPNState
  -> ObjectPath
  -> IO ()
 updateState f state op = modifyMVar_ state $ return . f op
 --------------------------------------------------------------------------------
-- | Tunnel Device Detection
+-- Tunnel Device Detection
 --
 getVPNObjectTree :: SysClient -> IO ObjectTree
 getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
@ -91,25 +90,30 @@ addedCallback state display [device, added] = update >> display
    added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant))
    is = M.keys $ fromMaybe M.empty added'
    update = updateDevice S.insert state device is
-addedCallback _ _ _                       = return ()
+addedCallback _ _ _ = return ()
 removedCallback :: MutableVPNState -> IO () -> SignalCallback
 removedCallback state display [device, interfaces] = update >> display
  where
    is = fromMaybe [] $ fromVariant interfaces :: [T.Text]
    update = updateDevice S.delete state device is
-removedCallback _ _ _                       = return ()
+removedCallback _ _ _ = return ()
-updateDevice :: (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
+updateDevice
-  -> Variant -> [T.Text] -> IO ()
+  :: (ObjectPath -> VPNState -> VPNState)
-updateDevice f state device interfaces = when (vpnDeviceTun `elem` interfaces) $
+  -> MutableVPNState
-  forM_ d $ updateState f state
+  -> Variant
  -> [T.Text]
  -> IO ()
 updateDevice f state device interfaces =
  when (vpnDeviceTun `elem` interfaces) $
    forM_ d $
      updateState f state
  where
    d = fromVariant device :: Maybe ObjectPath
 --------------------------------------------------------------------------------
-- | DBus Interface
+-- DBus Interface
 --
 vpnBus :: BusName
 vpnBus = busName_ "org.freedesktop.NetworkManager"
@ -124,5 +128,6 @@ vpnAlias :: T.Text
 vpnAlias = "vpn"
 vpnDep :: DBusDependency_ SysClient
-vpnDep = Endpoint networkManagerPkgs networkManagerBus vpnPath omInterface
+vpnDep =
-  $ Method_ getManagedObjects
+  Endpoint networkManagerPkgs networkManagerBus vpnPath omInterface $
    Method_ getManagedObjects
--- a/package.yaml
+++ b/package.yaml
@ -7,7 +7,7 @@ copyright:           "2022 Nathan Dwarshuis"
 extra-source-files:
 - README.md
- .stylish-haskell.yaml
+- fourmolu.yaml
 - make_pkgs
 - icons/*
 - scripts/*
Author	SHA1	Message	Date
Nathan Dwarshuis	adf0257533	REF reformat everything with fourmolu	2022-12-30 14:58:23 -05:00
Nathan Dwarshuis	b2b0f72178	ENH use fourmolu	2022-12-30 12:21:53 -05:00
Nathan Dwarshuis	d560db1548	Revert "WIP use unliftio everywhere-ish" This reverts commit `769df2fb00`.	2022-12-30 10:56:09 -05:00
Nathan Dwarshuis	769df2fb00	WIP use unliftio everywhere-ish	2022-12-30 10:38:21 -05:00
Nathan Dwarshuis	017d13d80c	ENH clean up docs in shell	2022-12-29 15:22:48 -05:00