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 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,19 +14,14 @@
 -- until its PID exits. By monitoring this wrapper, the dynamic workspace only
 -- has one process to track and will maintain the workspace throughout the
 -- lifetime of the VM.
 module Main (main) where
 import qualified Data.ByteString.Lazy.UTF8 as BU
 import RIO
 import RIO.Process
 import qualified RIO.Text as T
 import           Text.XML.Light
 import System.Environment
-
+import Text.XML.Light
 import XMonad.Internal.Concurrent.VirtualBox
 import XMonad.Internal.IO
@ -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,7 +49,9 @@ vmLaunch i = do
  rc <- proc "VBoxManage" ["startvm", T.unpack i] runProcess
  case rc of
    ExitSuccess -> return ()
-    _           -> logError $ "Failed to start VM: "
+    _ ->
      logError $
        "Failed to start VM: "
          <> displayBytesUtf8 (encodeUtf8 i)
 vmPID :: T.Text -> RIO SimpleApp (Maybe Int)
@ -73,8 +68,9 @@ vmMachineID iPath = do
    Right contents -> return $ findMachineID contents
    Left e -> logError (displayShow e) >> return Nothing
  where
-    findMachineID c = T.stripSuffix "}"
+    findMachineID c =
      T.stripSuffix "}"
        =<< T.stripPrefix "{"
-      =<< (fmap T.pack . findAttr (blank_name { qName = "uuid" }))
+        =<< (fmap T.pack . findAttr (blank_name {qName = "uuid"}))
        =<< (\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,29 +9,19 @@ module Main (main) where
 -- * Some custom plugins (imported below)
 -- * Theme integration with xmonad (shared module imported below)
 -- * A custom Locks plugin from my own forked repo
 module Main (main) where
 import Control.Monad
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import Data.List
 import Data.Maybe
 import RIO hiding (hFlush)
 import qualified RIO.ByteString.Lazy as BL
 import RIO.Process
 import qualified RIO.Text as T
 import System.Environment
 import System.IO
 import           Xmobar.Plugins.Bluetooth
 import           Xmobar.Plugins.ClevoKeyboard
 import           Xmobar.Plugins.Device
 import           Xmobar.Plugins.IntelBacklight
 import           Xmobar.Plugins.Screensaver
 import           Xmobar.Plugins.VPN
 import XMonad.Core hiding (config)
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.Command.Power
@ -47,8 +34,13 @@ import           Xmobar                                         hiding
  ( iconOffset
  , run
  )
 import Xmobar.Plugins.Bluetooth
 import Xmobar.Plugins.ClevoKeyboard
 import Xmobar.Plugins.Common
-
+import Xmobar.Plugins.Device
 import Xmobar.Plugins.IntelBacklight
 import Xmobar.Plugins.Screensaver
 import Xmobar.Plugins.VPN
 main :: IO ()
 main = getArgs >>= parse
@ -84,13 +76,16 @@ printDeps = do
  io $ disconnectDBus db
 usage :: IO ()
-usage = putStrLn $ intercalate "\n"
+usage =
  putStrLn $
    intercalate
      "\n"
      [ "xmobar: run greatest taskbar"
      , "xmobar --deps: print dependencies"
      ]
 --------------------------------------------------------------------------------
-- | toplevel configuration
+-- toplevel configuration
 -- | The text font family
 textFont :: Always XT.FontBuilder
@ -102,11 +97,14 @@ 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 =
  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)
@ -125,14 +123,15 @@ 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 =
  defaultConfig
    { font = T.unpack bf
    , additionalFonts = fmap T.unpack ifs
    , textOffset = textFontOffset
@ -142,32 +141,31 @@ config bf ifs ios br confDir = defaultConfig
    , position = BottomSize C 100 24
    , border = NoBorder
    , borderColor = T.unpack XT.bordersColor
    , sepChar = T.unpack pSep
    , alignSep = [lSep, rSep]
    , template = T.unpack $ fmtRegions br
    , lowerOnStart = False
    , hideOnStart = False
    , allDesktops = True
    , overrideRedirect = True
    , pickBroadest = False
    , persistent = True
-  -- store the icons with the xmonad/xmobar stack project
+    , -- store the icons with the xmonad/xmobar stack project
-  , iconRoot = confDir ++ "/icons"
+      iconRoot = confDir ++ "/icons"
    , commands = csRunnable <$> concatRegions br
    }
 --------------------------------------------------------------------------------
-- | plugin features
+--  plugin features
 --
 -- some commands depend on the presence of interfaces that can only be
 -- determined at runtime; define these checks here
 getAllCommands :: [Maybe CmdSpec] -> BarRegions
-getAllCommands right = BarRegions
+getAllCommands right =
-  { brLeft = [ CmdSpec
+  BarRegions
    { brLeft =
        [ CmdSpec
            { csAlias = "UnsafeStdinReader"
            , csRunnable = Run UnsafeStdinReader
            }
@ -177,13 +175,15 @@ getAllCommands right = BarRegions
    }
 rightPlugins :: DBusState -> FIO [Maybe CmdSpec]
-rightPlugins db = mapM evalFeature $ allFeatures db
+rightPlugins db =
  mapM evalFeature $
    allFeatures db
      ++ [always' "date indicator" dateCmd]
  where
    always' n = Right . Always n . Always_ . FallbackAlone
 allFeatures :: DBusState -> [Feature CmdSpec]
-allFeatures DBusState { dbSesClient = ses, dbSysClient = sys } =
+allFeatures DBusState {dbSesClient = ses, dbSysClient = sys} =
  [ Left getWireless
  , Left $ getEthernet sys
  , Left $ getVPN sys
@ -200,7 +200,10 @@ type BarFeature = Sometimes CmdSpec
 -- TODO what if I don't have a wireless card?
 getWireless :: BarFeature
-getWireless = Sometimes "wireless status indicator" xpfWireless
+getWireless =
  Sometimes
    "wireless status indicator"
    xpfWireless
    [Subfeature (IORoot wirelessCmd $ Only readWireless) "sysfs path"]
 getEthernet :: Maybe SysClient -> BarFeature
@ -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,29 +269,58 @@ 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_)
  -> T.Text
  -> XPQuery
  -> (Fontifier -> t -> Root CmdSpec)
  -> t
  -> BarFeature
 iconSometimes' c d n q r t =
  Sometimes
    n
    q
    [ Subfeature icon "icon indicator"
    , Subfeature text "text indicator"
    ]
@ -280,125 +329,170 @@ iconSometimes' c d n q r t = Sometimes n q
    text = r fontifyAlt t
 --------------------------------------------------------------------------------
-- | command specifications
+-- command specifications
 data BarRegions = BarRegions
  { brLeft :: [CmdSpec]
  , brCenter :: [CmdSpec]
  , brRight :: [CmdSpec]
-  } deriving Show
+  }
  deriving (Show)
 data CmdSpec = CmdSpec
  { 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 =
  CmdSpec
    { 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
        [ "-t"
        , "<qualityipat><essid>"
        , "--"
-      , "--quality-icon-pattern", "<icon=wifi_%%.xpm/>"
+        , "--quality-icon-pattern"
        , "<icon=wifi_%%.xpm/>"
        ]
 ethernetCmd :: Fontifier -> T.Text -> CmdSpec
-ethernetCmd fontify iface = CmdSpec
+ethernetCmd fontify iface =
  CmdSpec
    { csAlias = iface
-  , csRunnable = Run
+    , csRunnable =
-    $ Device (iface, fontify IconMedium "\xf0e8" "ETH", colors)
+        Run $
          Device (iface, fontify IconMedium "\xf0e8" "ETH", colors)
    }
 batteryCmd :: Fontifier -> CmdSpec
-batteryCmd fontify = CmdSpec
+batteryCmd fontify =
  CmdSpec
    { 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"
        , "80"
        , "--low"
        , "red"
        , "--normal"
        , XT.fgColor
        , "--high"
        , XT.fgColor
        , "--"
        , "-P"
-      , "-o" , fontify' "\xf0e7" "BAT"
+        , "-o"
-      , "-O" , fontify' "\xf1e6" "AC"
+        , fontify' "\xf0e7" "BAT"
-      , "-i" , fontify' "\xf1e6" "AC"
+        , "-O"
        , fontify' "\xf1e6" "AC"
        , "-i"
        , fontify' "\xf1e6" "AC"
        ]
 vpnCmd :: Fontifier -> CmdSpec
-vpnCmd fontify = CmdSpec
+vpnCmd fontify =
  CmdSpec
    { csAlias = vpnAlias
    , csRunnable = Run $ VPN (fontify IconMedium "\xf023" "VPN", colors)
    }
 btCmd :: Fontifier -> CmdSpec
-btCmd fontify = CmdSpec
+btCmd fontify =
  CmdSpec
    { csAlias = btAlias
-  , csRunnable = Run
+    , csRunnable =
-    $ Bluetooth (fontify' "\xf5b0" "+", fontify' "\xf5ae" "-") colors
+        Run $
          Bluetooth (fontify' "\xf5b0" "+", fontify' "\xf5ae" "-") colors
    }
  where
    fontify' i = fontify IconLarge i . T.append "BT"
 alsaCmd :: Fontifier -> CmdSpec
-alsaCmd fontify = CmdSpec
+alsaCmd fontify =
  CmdSpec
    { csAlias = "alsa:default:Master"
-  , csRunnable = Run
+    , csRunnable =
-    $ Alsa "default" "Master"
+        Run $
-    $ fmap T.unpack
+          Alsa "default" "Master" $
-    [ "-t", "<status><volume>%"
+            fmap
              T.unpack
              [ "-t"
              , "<status><volume>%"
              , "--"
-    , "-O", fontify' "\xf028" "+"
+              , "-O"
-    , "-o", T.append (fontify' "\xf026" "-") " "
+              , fontify' "\xf028" "+"
-    , "-c", XT.fgColor
+              , "-o"
-    , "-C", XT.fgColor
+              , 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 =
  CmdSpec
    { csAlias = blAlias
    , csRunnable = Run $ IntelBacklight $ fontify IconSmall "\xf185" "BL: "
    }
 ckCmd :: Fontifier -> CmdSpec
-ckCmd fontify = CmdSpec
+ckCmd fontify =
  CmdSpec
    { csAlias = ckAlias
    , csRunnable = Run $ ClevoKeyboard $ fontify IconSmall "\xf40b" "KB: "
    }
 ssCmd :: Fontifier -> CmdSpec
-ssCmd fontify = CmdSpec
+ssCmd fontify =
  CmdSpec
    { csAlias = ssAlias
    , csRunnable = Run $ Screensaver (fontify IconSmall "\xf254" "SS", colors)
    }
 lockCmd :: Fontifier -> CmdSpec
-lockCmd fontify = CmdSpec
+lockCmd fontify =
  CmdSpec
    { csAlias = "locks"
-  , csRunnable = Run
+    , csRunnable =
-    $ Locks
+        Run $
-    $ fmap T.unpack
+          Locks $
-    [ "-N", numIcon
+            fmap
-    , "-n", disabledColor numIcon
+              T.unpack
-    , "-C", capIcon
+              [ "-N"
-    , "-c", disabledColor capIcon
+              , numIcon
-    , "-s", ""
+              , "-n"
-    , "-S", ""
+              , disabledColor numIcon
-    , "-d", " "
+              , "-C"
              , capIcon
              , "-c"
              , disabledColor capIcon
              , "-s"
              , ""
              , "-S"
              , ""
              , "-d"
              , " "
              ]
    }
  where
@ -408,33 +502,37 @@ lockCmd fontify = CmdSpec
    disabledColor = xmobarFGColor XT.backdropFgColor
 dateCmd :: CmdSpec
-dateCmd = CmdSpec
+dateCmd =
  CmdSpec
    { csAlias = "date"
    , csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
    }
 --------------------------------------------------------------------------------
-- | low-level testing functions
+-- low-level testing functions
 vpnPresent :: FIO (Maybe Msg)
 vpnPresent = do
  res <- proc "nmcli" args readProcess
  return $ case res of
-    (ExitSuccess, out, _) | "vpn" `elem` BL.split 10 out -> Nothing
+    (ExitSuccess, out, _)
      | "vpn" `elem` BL.split 10 out -> Nothing
      | otherwise -> Just $ Msg LevelError "vpn not found"
-    (ExitFailure c, _, err) -> Just $ Msg LevelError
+    (ExitFailure c, _, err) ->
-                               $ T.concat
+      Just $
-                               ["vpn search exited with code "
+        Msg LevelError $
          T.concat
            [ "vpn search exited with code "
            , T.pack $ show c
            , ": "
-                               , T.decodeUtf8With T.lenientDecode
+            , T.decodeUtf8With T.lenientDecode $
-                                 $ BL.toStrict err
+                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 =
      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} =
  T.concat
    [fmtSpecs l, T.singleton lSep, fmtSpecs c, T.singleton rSep, fmtSpecs r]
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@ -4,35 +4,30 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | XMonad binary
+--  XMonad binary
 module Main (main) where
 import Control.Monad
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import Data.List
 import Data.Maybe
 import Data.Monoid
 import Data.Text.IO (hPutStrLn)
 import Graphics.X11.Types
 import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Extras
 import RIO
 import RIO.Directory
 import RIO.Process
 import qualified RIO.Text as T
 import System.Environment
 import System.Posix.Signals
 import System.Process
  ( getPid
  , getProcessExitCode
  )
 import XMonad
 import XMonad.Actions.CopyWindow
 import XMonad.Actions.CycleWS
@ -110,10 +105,12 @@ run = do
          sk <- evalAlways $ fsShowKeys fs
          ha <- evalAlways $ fsACPIHandler fs
          tt <- evalAlways $ fsTabbedTheme fs
-          let conf = ewmh
+          let conf =
-                $ addKeymap dws sk kbs
+                ewmh $
-                $ docks
+                  addKeymap dws sk kbs $
-                $ def { terminal = myTerm
+                    docks $
                      def
                        { terminal = myTerm
                        , modMask = myModMask
                        , layoutHook = myLayouts tt
                        , manageHook = myManageHook dws
@ -128,8 +125,11 @@ run = do
                        }
          io $ runXMonad conf
  where
-    startRemovableMon db fs = void $ executeSometimes $ fsRemovableMon fs
+    startRemovableMon db fs =
-                        $ dbSysClient db
+      void $
        executeSometimes $
          fsRemovableMon fs $
            dbSysClient db
    startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
    startDynWorkspaces fs = do
      dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
@ -142,8 +142,9 @@ runXMonad conf = do
  launch conf dirs
 startDBusInterfaces :: DBusState -> FeatureSet -> FIO ()
-startDBusInterfaces db fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
+startDBusInterfaces db fs =
-  $ fsDBusExporters fs
+  mapM_ (\f -> executeSometimes $ f $ dbSesClient db) $
    fsDBusExporters fs
 getCreateDirectories :: IO Directories
 getCreateDirectories = do
@ -178,7 +179,8 @@ tabbedFeature = Always "theme for tabbed windows" $ Option sf fallback
    fallback = Always_ $ FallbackAlone $ XT.tabbedTheme XT.fallbackFont
 features :: Maybe SysClient -> FeatureSet
-features cl = FeatureSet
+features cl =
  FeatureSet
    { fsKeys = externalBindings
    , fsDBusExporters = dbusExporters
    , fsPowerMon = runPowermon
@ -196,7 +198,8 @@ startXmobar = do
  io $ hSetBuffering (getStdin p) LineBuffering
  return p
  where
-    start = startProcess
+    start =
      startProcess
        . setStdin createPipe
        . setCreateGroup True
@ -228,32 +231,37 @@ printDeps :: FIO ()
 printDeps = do
  db <- io connectDBus
  (i, f, d) <- allFeatures db
-  io $ mapM_ (putStrLn . T.unpack)
+  io $
-    $ fmap showFulfillment
+    mapM_ (putStrLn . T.unpack) $
-    $ sort
+      fmap showFulfillment $
-    $ nub
+        sort $
-    $ concat
+          nub $
-    $ fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
+            concat $
              fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
  io $ disconnectDBus db
 allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
 allFeatures db = do
-  let bfs = concatMap (fmap kbMaybeAction . kgBindings)
+  let bfs =
-            $ externalBindings ts db
+        concatMap (fmap kbMaybeAction . kgBindings) $
          externalBindings ts db
  let dbus = fmap (\f -> f $ dbSesClient db) dbusExporters
  let others = [runRemovableMon $ dbSysClient db, runPowermon]
-  return (dbus ++ others, Left runScreenLock:bfs, allDWs')
+  return (dbus ++ others, Left runScreenLock : bfs, allDWs')
  where
-    ts = ThreadState { tsChildPIDs = [], tsXmobar = Nothing }
+    ts = ThreadState {tsChildPIDs = [], tsXmobar = Nothing}
 usage :: IO ()
-usage = putStrLn $ intercalate "\n"
+usage =
  putStrLn $
    intercalate
      "\n"
      [ "xmonad: run greatest window manager"
      , "xmonad --deps: print dependencies"
      ]
 --------------------------------------------------------------------------------
-- | Concurrency configuration
+-- Concurrency configuration
 data ThreadState = ThreadState
  { tsChildPIDs :: [Process () () ()]
@ -294,18 +302,19 @@ killNoWait p = do
    handleIO (\_ -> return ()) $ stopProcess p
 --------------------------------------------------------------------------------
-- | Startuphook configuration
+-- Startuphook configuration
 -- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED?
 myStartupHook :: X ()
-myStartupHook = setDefaultCursor xC_left_ptr
+myStartupHook =
  setDefaultCursor xC_left_ptr
    <+> startupHook def
 --------------------------------------------------------------------------------
-- | Workspace configuration
+-- Workspace configuration
 myWorkspaces :: [WorkspaceId]
-myWorkspaces = map show [1..10 :: Int]
+myWorkspaces = map show [1 .. 10 :: Int]
 gimpTag :: String
 gimpTag = "GIMP"
@ -323,7 +332,8 @@ gimpDynamicWorkspace :: Sometimes DynWorkspace
 gimpDynamicWorkspace = sometimesIO_ "gimp workspace" "gimp" tree dw
  where
    tree = Only_ $ sysExe [Package Official "gimp"] exe
-    dw = DynWorkspace
+    dw =
      DynWorkspace
        { dwName = "Gimp"
        , dwTag = gimpTag
        , dwClass = c
@ -337,96 +347,121 @@ gimpDynamicWorkspace = sometimesIO_ "gimp workspace" "gimp" tree dw
        , dwCmd = Just $ spawnCmd exe []
        }
    exe = "gimp-2.10"
-    matchGimpRole role = isPrefixOf role <$> stringProperty "WM_WINDOW_ROLE"
+    matchGimpRole role =
-      <&&> className =? c
+      isPrefixOf role
        <$> stringProperty "WM_WINDOW_ROLE"
        <&&> className
        =? c
    c = "Gimp-2.10" -- TODO I don't feel like changing the version long term
 -- TODO don't hardcode the VM name/title/shortcut
 vmDynamicWorkspace :: Sometimes DynWorkspace
-vmDynamicWorkspace = Sometimes "virtualbox workspace" xpfVirtualBox
+vmDynamicWorkspace =
  Sometimes
    "virtualbox workspace"
    xpfVirtualBox
    [Subfeature root "windows 8 VM"]
  where
-    root = IORoot_ dw $ toAnd_ (sysExe [Package Official "virtualbox"] "VBoxManage")
+    root =
-      $ IOTest_ name [] $ io $ vmExists vm
+      IORoot_ dw $
        toAnd_ (sysExe [Package Official "virtualbox"] "VBoxManage") $
          IOTest_ name [] $
            io $
              vmExists vm
    name = T.unwords ["test if", vm, "exists"]
    c = "VirtualBoxVM"
    vm = "win8raw"
-    dw = DynWorkspace
+    dw =
      DynWorkspace
        { dwName = "Windows VirtualBox"
        , dwTag = vmTag
        , dwClass = c
-         , dwHook = [ className =? c -?> appendViewShift vmTag ]
+        , dwHook = [className =? c -?> appendViewShift vmTag]
        , dwKey = 'v'
        , dwCmd = Just $ spawnCmd "vbox-start" [vm]
        }
 xsaneDynamicWorkspace :: Sometimes DynWorkspace
-xsaneDynamicWorkspace = Sometimes "scanner workspace" xpfXSANE
+xsaneDynamicWorkspace =
  Sometimes
    "scanner workspace"
    xpfXSANE
    [Subfeature (IORoot_ dw tree) "xsane"]
  where
    tree = Only_ $ sysExe [Package Official "xsane"] "xsane"
-    dw = DynWorkspace
+    dw =
      DynWorkspace
        { dwName = "XSane"
        , dwTag = xsaneTag
        , dwClass = c
-         , dwHook = [ className =? c -?> appendViewShift xsaneTag >> doFloat ]
+        , dwHook = [className =? c -?> appendViewShift xsaneTag >> doFloat]
        , dwKey = 'x'
        , dwCmd = Just $ spawnCmd "xsane" []
        }
    c = "Xsane"
 f5vpnDynamicWorkspace :: Sometimes DynWorkspace
-f5vpnDynamicWorkspace = Sometimes "F5 VPN workspace" xpfF5VPN
+f5vpnDynamicWorkspace =
  Sometimes
    "F5 VPN workspace"
    xpfF5VPN
    [Subfeature (IORoot_ dw tree) "f5vpn"]
  where
    tree = Only_ $ sysExe [Package AUR "f5vpn"] "f5vpn"
-    dw = DynWorkspace
+    dw =
      DynWorkspace
        { dwName = "F5Vpn"
        , dwTag = f5Tag
        , dwClass = c
-         , dwHook = [ className =? c -?> appendShift f5Tag ]
+        , dwHook = [className =? c -?> appendShift f5Tag]
        , dwKey = 'i'
        , dwCmd = Just skip
        }
    c = "F5 VPN"
 allDWs' :: [Sometimes DynWorkspace]
-allDWs' = [xsaneDynamicWorkspace
+allDWs' =
  [ xsaneDynamicWorkspace
  , vmDynamicWorkspace
  , gimpDynamicWorkspace
  , f5vpnDynamicWorkspace
  ]
 --------------------------------------------------------------------------------
-- | Layout configuration
+-- Layout configuration
 -- NOTE this will have all available layouts, even those that may be for
 -- features that failed. Trying to dynamically take out a layout seems to
 -- make a new type :/
-myLayouts tt = onWorkspace vmTag vmLayout
+myLayouts tt =
-  $ onWorkspace gimpTag gimpLayout
+  onWorkspace vmTag vmLayout $
-  $ mkToggle (single HIDE)
+    onWorkspace gimpTag gimpLayout $
-  $ tall ||| fulltab ||| full
+      mkToggle (single HIDE) $
        tall ||| fulltab ||| full
  where
    addTopBar = noFrillsDeco shrinkText tt
-    tall = renamed [Replace "Tall"]
+    tall =
-      $ avoidStruts
+      renamed [Replace "Tall"] $
-      $ addTopBar
+        avoidStruts $
-      $ noBorders
+          addTopBar $
-      $ Tall 1 0.03 0.5
+            noBorders $
-    fulltab = renamed [Replace "Tabbed"]
+              Tall 1 0.03 0.5
-      $ avoidStruts
+    fulltab =
-      $ noBorders
+      renamed [Replace "Tabbed"] $
-      $ tabbedAlways shrinkText tt
+        avoidStruts $
-    full = renamed [Replace "Full"]
+          noBorders $
-      $ noBorders Full
+            tabbedAlways shrinkText tt
    full =
      renamed [Replace "Full"] $
        noBorders Full
    vmLayout = noBorders Full
    -- TODO use a tabbed layout for multiple master windows
-    gimpLayout = renamed [Replace "Gimp Layout"]
+    gimpLayout =
-      $ avoidStruts
+      renamed [Replace "Gimp Layout"] $
-      $ noBorders
+        avoidStruts $
-      $ addTopBar
+          noBorders $
-      $ Tall 1 0.025 0.8
+            addTopBar $
              Tall 1 0.025 0.8
 -- | Make a new empty layout and add a message to show/hide it. This is useful
 -- for quickly showing conky.
@ -448,8 +483,7 @@ runHide :: X ()
 runHide = sendMessage $ Toggle HIDE
 --------------------------------------------------------------------------------
-- | Loghook configuration
+-- Loghook configuration
 --
 myLoghook :: Process Handle () () -> X ()
 myLoghook h = do
@ -467,7 +501,7 @@ myLoghook h = do
 -- _NET_DESKTOP_VIEWPORT, but for now there seems to be no ill effects so why
 -- bother...(if that were necessary it would go in the startup hook)
 newtype DesktopViewports = DesktopViewports [Int]
-    deriving Eq
+  deriving (Eq)
 instance ExtensionClass DesktopViewports where
  initialValue = DesktopViewports []
@ -480,8 +514,9 @@ logViewports = withWindowSet $ \s -> do
  whenChanged (DesktopViewports desktopViewports) $
    setDesktopViewports desktopViewports
  where
-    wsToViewports s w = let cur = W.current s in
+    wsToViewports s w =
-      if W.tag w == currentTag cur then currentPos cur else [0, 0]
+      let cur = W.current s
       in if W.tag w == currentTag cur then currentPos cur else [0, 0]
    currentTag = W.tag . W.workspace
    currentPos = rectXY . screenRect . W.screenDetail
    rectXY (Rectangle x y _ _) = [fromIntegral x, fromIntegral y]
@ -507,20 +542,22 @@ whenChanged v action = do
 -- currently visible and the order reflects the physical location of each
 -- screen. The "<>" is the workspace that currently has focus. N is the number
 -- of windows on the current workspace.
 logXinerama :: Process Handle () () -> X ()
-logXinerama p = withWindowSet $ \ws -> io
+logXinerama p = withWindowSet $ \ws ->
-  $ hPutStrLn (getStdin p)
+  io $
-  $ T.unwords
+    hPutStrLn (getStdin p) $
-  $ filter (not . T.null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws]
+      T.unwords $
        filter (not . T.null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws]
  where
-    onScreen ws = xmobarColor_ hilightFgColor hilightBgColor
+    onScreen ws =
-      $ (T.pack . pad . T.unpack)
+      xmobarColor_ hilightFgColor hilightBgColor $
-      $ T.unwords
+        (T.pack . pad . T.unpack) $
-      $ map (fmtTags ws . W.tag . W.workspace)
+          T.unwords $
-      $ sortBy compareXCoord
+            map (fmtTags ws . W.tag . W.workspace) $
-      $ W.current ws : W.visible ws
+              sortBy compareXCoord $
-    offScreen = xmobarColor_ XT.backdropFgColor ""
+                W.current ws : W.visible ws
    offScreen =
      xmobarColor_ XT.backdropFgColor ""
        . T.unwords
        . fmap (T.pack . W.tag)
        . filter (isJust . W.stack)
@ -528,7 +565,8 @@ logXinerama p = withWindowSet $ \ws -> io
        . W.hidden
    sep = xmobarColor_ XT.backdropFgColor "" ":"
    layout = T.pack . description . W.layout . W.workspace . W.current
-    nWindows = (\x -> T.concat ["(", x, ")"])
+    nWindows =
      (\x -> T.concat ["(", x, ")"])
        . T.pack
        . show
        . length
@ -538,53 +576,57 @@ logXinerama p = withWindowSet $ \ws -> io
        . W.current
    hilightBgColor = "#A6D3FF"
    hilightFgColor = XT.blend' 0.4 hilightBgColor XT.fgColor
-    fmtTags ws t = let t_ = T.pack t in
+    fmtTags ws t =
-      if t == W.currentTag ws
+      let t_ = T.pack t
       in if t == W.currentTag ws
            then xmobarColor_ XT.fgColor hilightBgColor t_
            else t_
    xmobarColor_ a b c = T.pack $ xmobarColor (T.unpack a) (T.unpack b) (T.unpack c)
 compareXCoord
  :: W.Screen i1 l1 a1 ScreenId ScreenDetail
-     -> W.Screen i2 l2 a2 ScreenId ScreenDetail -> Ordering
+  -> W.Screen i2 l2 a2 ScreenId ScreenDetail
  -> Ordering
 compareXCoord s0 s1 = compare (go s0) (go s1)
  where
    go = (\(Rectangle x _ _ _) -> x) . snd . getScreenIdAndRectangle
 --------------------------------------------------------------------------------
-- | Managehook configuration
+-- Managehook configuration
 myManageHook :: [DynWorkspace] -> ManageHook
 myManageHook dws = manageApps dws <+> manageHook def
 manageApps :: [DynWorkspace] -> ManageHook
-manageApps dws = composeOne $ concatMap dwHook dws ++
+manageApps dws =
-  [ isDialog -?> doCenterFloat
+  composeOne $
-  -- the seafile applet
+    concatMap dwHook dws
-  , className =? "Seafile Client" -?> doFloat
+      ++ [ isDialog -?> doCenterFloat
-  -- gnucash
+         , -- the seafile applet
-  , (className =? "Gnucash" <&&> title =? "Transaction Import Assistant") -?> doFloat
+           className =? "Seafile Client" -?> doFloat
-  -- plots and graphics
+         , -- gnucash
-  , className =? "R_x11" -?> doFloat
+           (className =? "Gnucash" <&&> title =? "Transaction Import Assistant") -?> doFloat
         , -- plots and graphics
           className =? "R_x11" -?> doFloat
         , className =? "Matplotlib" -?> doFloat
         , className =? "mpv" -?> doFloat
-  -- the floating windows created by the brave browser
+         , -- the floating windows created by the brave browser
-  , stringProperty "WM_NAME" =? "Brave" -?> doFloat
+           stringProperty "WM_NAME" =? "Brave" -?> doFloat
-  -- , (stringProperty "WM_WINDOW_ROLE" =? "pop-up"
+         , -- , (stringProperty "WM_WINDOW_ROLE" =? "pop-up"
           --    <&&> className =? "Brave-browser") -?> doFloat
           -- the dialog windows created by the zotero addon in Google Docs
-  , (className =? "Zotero" <&&> resource =? "Toplevel") -?> doFloat
+           (className =? "Zotero" <&&> resource =? "Toplevel") -?> doFloat
         ]
 --------------------------------------------------------------------------------
-- | Eventhook configuration
+-- Eventhook configuration
 myEventHook :: (String -> X ()) -> Event -> X All
 myEventHook handler = xMsgEventHook handler <+> handleEventHook def
 -- | React to ClientMessage events from concurrent threads
 xMsgEventHook :: (String -> X ()) -> Event -> X All
-xMsgEventHook handler ClientMessageEvent { ev_message_type = t, ev_data = d }
+xMsgEventHook handler ClientMessageEvent {ev_message_type = t, ev_data = d}
  | t == bITMAP = do
      let (xtype, tag) = splitXMsg d
      case xtype of
@ -595,19 +637,26 @@ xMsgEventHook handler ClientMessageEvent { ev_message_type = t, ev_data = d }
 xMsgEventHook _ _ = return (All True)
 --------------------------------------------------------------------------------
-- | Keymap configuration
+-- Keymap configuration
 myModMask :: KeyMask
 myModMask = mod4Mask
-addKeymap :: [DynWorkspace] -> ([((KeyMask, KeySym), NamedAction)] -> X ())
+addKeymap
-  -> [KeyGroup (X ())] -> XConfig l -> XConfig l
+  :: [DynWorkspace]
-addKeymap dws showKeys external = addDescrKeys' ((myModMask, xK_F1), showKeys)
+  -> ([((KeyMask, KeySym), NamedAction)] -> X ())
  -> [KeyGroup (X ())]
  -> XConfig l
  -> XConfig l
 addKeymap dws showKeys external =
  addDescrKeys'
    ((myModMask, xK_F1), showKeys)
    (\c -> concatMap (mkNamedSubmap c) $ internalBindings dws c ++ external)
 internalBindings :: [DynWorkspace] -> XConfig Layout -> [KeyGroup (X ())]
 internalBindings dws c =
-  [ KeyGroup "Window Layouts"
+  [ KeyGroup
      "Window Layouts"
      [ KeyBinding "M-j" "focus down" $ windows W.focusDown
      , KeyBinding "M-k" "focus up" $ windows W.focusUp
      , KeyBinding "M-m" "focus master" $ windows W.focusMaster
@ -624,32 +673,36 @@ internalBindings dws c =
      , KeyBinding "M-S--" "remove master window" $ sendMessage $ IncMasterN (-1)
      , KeyBinding "M-S-=" "add master window" $ sendMessage $ IncMasterN 1
      ]
-
+  , KeyGroup
-  , KeyGroup "Workspaces"
+      "Workspaces"
      -- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get
      -- valid keysyms)
-    ([ KeyBinding (mods ++ n) (msg ++ n) (f n) | n <- myWorkspaces
+      ( [ KeyBinding (mods ++ n) (msg ++ n) (f n) | n <- myWorkspaces, (mods, msg, f) <-
      , (mods, msg, f) <-
                                                                        [ ("M-", "switch to workspace ", windows . W.view)
                                                                        , ("M-S-", "move client to workspace ", windows . W.shift)
-        , ("M-C-", "follow client to workspace ", \n' -> do
+                                                                        ,
                                                                          ( "M-C-"
                                                                          , "follow client to workspace "
                                                                          , \n' -> do
                                                                              windows $ W.shift n'
-              windows $ W.view n')
+                                                                              windows $ W.view n'
                                                                          )
                                                                        ]
-     ] ++
+        ]
-     [ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next (hiddenWS :&: Not emptyWS)
+          ++ [ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next (hiddenWS :&: Not emptyWS)
             , KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev (hiddenWS :&: Not emptyWS)
-     ])
+             ]
-
+      )
-  , KeyGroup "Dynamic Workspaces"
+  , KeyGroup
      "Dynamic Workspaces"
      [ KeyBinding ("M-C-" ++ [k]) ("launch/switch to " ++ n) cmd
-    |  DynWorkspace { dwTag = t, dwKey = k, dwCmd = a, dwName = n } <- dws,
+      | DynWorkspace {dwTag = t, dwKey = k, dwCmd = a, dwName = n} <- dws
-       let cmd = case a of
+      , let cmd = case a of
              Just a' -> spawnOrSwitch t a'
              Nothing -> windows $ W.view t
      ]
-
+  , KeyGroup
-  , KeyGroup "Screens"
+      "Screens"
      [ KeyBinding "M-l" "move up screen" nextScr
      , KeyBinding "M-h" "move down screen" prevScr
      , KeyBinding "M-C-l" "follow client up screen" $ nextScr' W.shift
@ -667,9 +720,10 @@ internalBindings dws c =
    nextScr' f = next f >> nextScr
 mkNamedSubmap :: XConfig Layout -> KeyGroup (X ()) -> [((KeyMask, KeySym), NamedAction)]
-mkNamedSubmap c KeyGroup { kgHeader = h, kgBindings = b } =
+mkNamedSubmap c KeyGroup {kgHeader = h, kgBindings = b} =
-  (subtitle h:) $ mkNamedKeymap c
+  (subtitle h :) $
-  $ (\KeyBinding{kbSyms = s, kbDesc = d, kbMaybeAction = a} -> (s, addName d a))
+    mkNamedKeymap c $
      (\KeyBinding {kbSyms = s, kbDesc = d, kbMaybeAction = a} -> (s, addName d a))
        <$> b
 data KeyBinding a = KeyBinding
@ -686,25 +740,28 @@ data KeyGroup a = KeyGroup
 evalExternal :: [KeyGroup FeatureX] -> FIO [KeyGroup MaybeX]
 evalExternal = mapM go
  where
-    go k@KeyGroup { kgBindings = bs } =
+    go k@KeyGroup {kgBindings = bs} =
-      (\bs' -> k { kgBindings = bs' }) <$> mapM evalKeyBinding bs
+      (\bs' -> k {kgBindings = bs'}) <$> mapM evalKeyBinding bs
 evalKeyBinding :: KeyBinding FeatureX -> FIO (KeyBinding MaybeX)
-evalKeyBinding k@KeyBinding { kbMaybeAction = a } =
+evalKeyBinding k@KeyBinding {kbMaybeAction = a} =
-  (\f -> k { kbMaybeAction = f }) <$> evalFeature a
+  (\f -> k {kbMaybeAction = f}) <$> evalFeature a
 filterExternal :: [KeyGroup MaybeX] -> [KeyGroup (X ())]
 filterExternal = fmap go
  where
-    go k@KeyGroup { kgBindings = bs } =
+    go k@KeyGroup {kgBindings = bs} =
-      k { kgBindings = [ kb { kbMaybeAction = x }
+      k
-                       | kb@KeyBinding { kbMaybeAction = Just x } <- bs
+        { kgBindings =
            [ kb {kbMaybeAction = x}
            | kb@KeyBinding {kbMaybeAction = Just x} <- bs
            ]
        }
 externalBindings :: ThreadState -> DBusState -> [KeyGroup FeatureX]
 externalBindings ts db =
-  [ KeyGroup "Launchers"
+  [ KeyGroup
      "Launchers"
      [ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu
      , KeyBinding "M-g" "launch clipboard manager" $ Left runClipMenu
      , KeyBinding "M-a" "launch network selector" $ Left $ runNetMenu sys
@ -720,8 +777,8 @@ externalBindings ts db =
      , KeyBinding "M-C-q" "launch calc" $ Left runCalc
      , KeyBinding "M-C-f" "launch file manager" $ Left runFileManager
      ]
-
+  , KeyGroup
-  , KeyGroup "Actions"
+      "Actions"
      [ KeyBinding "M-q" "close window" $ ftrAlways "kill window function" kill1
      , KeyBinding "M-r" "run program" $ Left runCmdMenu
      , KeyBinding "M-<Space>" "warp pointer" $ ftrAlways "warp function" $ warpToWindow 0.5 0.5
@ -731,8 +788,8 @@ externalBindings ts db =
      , KeyBinding "M-C-b" "browse captures" $ Left runCaptureBrowser
      -- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
      ]
-
+  , KeyGroup
-  , KeyGroup "Multimedia"
+      "Multimedia"
      [ KeyBinding "<XF86AudioPlay>" "toggle play/pause" $ Left runTogglePlay
      , KeyBinding "<XF86AudioPrev>" "previous track" $ Left runPrevTrack
      , KeyBinding "<XF86AudioNext>" "next track" $ Left runNextTrack
@ -741,15 +798,15 @@ externalBindings ts db =
      , KeyBinding "<XF86AudioRaiseVolume>" "volume up" $ Left runVolumeUp
      , KeyBinding "<XF86AudioMute>" "volume mute" $ Left runVolumeMute
      ]
-
+  , KeyGroup
-  , KeyGroup "Dunst"
+      "Dunst"
      [ KeyBinding "M-`" "dunst history" $ Left $ runNotificationHistory ses
      , KeyBinding "M-S-`" "dunst close" $ Left $ runNotificationClose ses
      , KeyBinding "M-M1-`" "dunst context menu" $ Left $ runNotificationContext ses
      , KeyBinding "M-C-`" "dunst close all" $ Left $ runNotificationCloseAll ses
      ]
-
+  , KeyGroup
-  , KeyGroup "System"
+      "System"
      [ KeyBinding "M-." "backlight up" $ ib bctlInc
      , KeyBinding "M-," "backlight down" $ ib bctlDec
      , KeyBinding "M-M1-," "backlight min" $ ib bctlMin
@ -761,8 +818,8 @@ externalBindings ts db =
      , KeyBinding "M-<End>" "power menu" $ Left runPowerPrompt
      , KeyBinding "M-<Home>" "quit xmonad" $ Left runQuitPrompt
      , KeyBinding "M-<Delete>" "lock screen" $ Left runScreenLock
-    -- M-<F1> reserved for showing the keymap
+      , -- M-<F1> reserved for showing the keymap
-    , KeyBinding "M-<F2>" "restart xmonad" restartf
+        KeyBinding "M-<F2>" "restart xmonad" restartf
      , KeyBinding "M-<F3>" "recompile xmonad" recompilef
      , KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
      , KeyBinding "M-<F9>" "toggle ethernet" $ Left runToggleEthernet
--- 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.Monad
-
+import DBus
 import DBus.Client
 import Data.Bifunctor
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified RIO.Text as T
 import           DBus
 import           DBus.Client
 --------------------------------------------------------------------------------
-- | Type-safe client
+-- Type-safe client
 class SafeClient c where
  toClient :: c -> Client
@ -86,24 +84,33 @@ getDBusClient' sys = do
    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 =
  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
  -> Maybe InterfaceName
  -> Maybe MemberName
  -> MatchRule
 matchSignal b p i m =
  matchAny
    { matchPath = p
    , matchSender = b
    , matchInterface = i
    , matchMember = m
    }
-matchSignalFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
+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)
@ -177,14 +213,19 @@ withSignalMatch f (Match x) = f (Just x)
 withSignalMatch f Failure = f Nothing
 withSignalMatch _ NoMatch = return ()
-matchPropertyChanged :: IsVariant a => InterfaceName -> T.Text -> [Variant]
+matchPropertyChanged
  :: IsVariant a
  => InterfaceName
  -> T.Text
  -> [Variant]
  -> SignalMatch a
 matchPropertyChanged iface property [i, body, _] =
  let i' = (fromVariant i :: Maybe T.Text)
-      b = toMap body in
+      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)
            then maybe NoMatch Match $ fromVariant =<< M.lookup property b'
            else NoMatch
        _ -> Failure
  where
@ -192,7 +233,7 @@ matchPropertyChanged iface property [i, body, _] =
 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
-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
@ -6,56 +6,52 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 --------------------------------------------------------------------------------
-- | Functions for handling dependencies
+-- Functions for handling dependencies
 module Data.Internal.Dependency
-  -- feature types
+-- feature types
  ( Feature
-  , Always(..)
+  , Always (..)
-  , Always_(..)
+  , Always_ (..)
-  , FallbackRoot(..)
+  , FallbackRoot (..)
-  , FallbackStack(..)
+  , FallbackStack (..)
-  , Sometimes(..)
+  , Sometimes (..)
  , Sometimes_
  , AlwaysX
  , AlwaysIO
  , SometimesX
  , SometimesIO
-  , PostPass(..)
+  , PostPass (..)
-  , Subfeature(..)
+  , Subfeature (..)
  , SubfeatureRoot
-  , Msg(..)
+  , Msg (..)
  -- configuration
-  , XParams(..)
+  , XParams (..)
-  , XPFeatures(..)
+  , XPFeatures (..)
  , XPQuery
  -- dependency tree types
-  , Root(..)
+  , Root (..)
-  , Tree(..)
+  , Tree (..)
-  , Tree_(..)
+  , Tree_ (..)
  , IOTree
  , IOTree_
  , DBusTree
  , DBusTree_
-  , SafeClient(..)
+  , SafeClient (..)
-  , IODependency(..)
+  , IODependency (..)
-  , IODependency_(..)
+  , IODependency_ (..)
-  , SystemDependency(..)
+  , SystemDependency (..)
-  , DBusDependency_(..)
+  , DBusDependency_ (..)
-  , DBusMember(..)
+  , DBusMember (..)
-  , UnitType(..)
+  , UnitType (..)
  , Result
-  , Fulfillment(..)
+  , Fulfillment (..)
-  , ArchPkg(..)
+  , ArchPkg (..)
  -- dumping
  , dumpFeature
  , dumpAlways
  , dumpSometimes
  , showFulfillment
  -- testing
  , FIO
  , withCache
@ -72,11 +68,9 @@ module Data.Internal.Dependency
  , readEthernet
  , readWireless
  , socketExists
  -- lifting
  , ioSometimes
  , ioAlways
  -- feature construction
  , always1
  , sometimes1
@ -86,7 +80,6 @@ module Data.Internal.Dependency
  , sometimesExe
  , sometimesExeArgs
  , sometimesEndpoint
  -- dependency construction
  , sysExe
  , localExe
@ -101,15 +94,16 @@ module Data.Internal.Dependency
  , voidResult
  , voidRead
  , process
  -- misc
  , shellTest
-  ) where
+  )
 where
 import Control.Monad.IO.Class
 import Control.Monad.Identity
 import Control.Monad.Reader
-
+import DBus hiding (typeOf)
 import qualified DBus.Introspection as I
 import Data.Aeson hiding (Error, Result)
 import Data.Aeson.Key
 import Data.Bifunctor
@ -118,30 +112,23 @@ import           Data.Internal.DBus
 import Data.List
 import Data.Maybe
 import Data.Yaml
 import GHC.IO.Exception (ioe_description)
 import           DBus                   hiding (typeOf)
 import qualified DBus.Introspection     as I
 import RIO hiding (bracket, fromString)
 import RIO.FilePath
 import RIO.Process hiding (findExecutable)
 import qualified RIO.Text as T
 import System.Directory
 import System.Environment
 import System.IO.Error
 import System.Posix.Files
 import System.Process.Typed (nullStream)
 import XMonad.Core (X, io)
 import XMonad.Internal.IO
 import XMonad.Internal.Shell hiding (proc, runProcess)
 import XMonad.Internal.Theme
 --------------------------------------------------------------------------------
-- | Feature Evaluation
+-- Feature Evaluation
 --
 -- Here we attempt to build and return the monadic actions encoded by each
 -- feature.
@ -195,15 +182,16 @@ logMsg (FMsg fn n (Msg ll m)) = do
    llFun LevelWarn = ("WARN", logWarn)
    llFun _ = ("DEBUG", logDebug)
    (s, f) = llFun ll
-    fmt p l = [ bracket p
+    fmt p l =
      [ bracket p
      , bracket l
      , bracket fn
      ]
-              ++ maybe [] ((:[]) . bracket) n
+        ++ maybe [] ((: []) . bracket) n
        ++ [m]
 --------------------------------------------------------------------------------
-- | Package status
+-- Package status
 showFulfillment :: Fulfillment -> T.Text
 showFulfillment (Package t n) = T.concat [T.pack $ show t, "\t", n]
@ -220,7 +208,7 @@ dumpSometimes :: Sometimes a -> [Fulfillment]
 dumpSometimes (Sometimes _ _ xs) = nub $ concatMap dataSubfeatureRoot xs
 --------------------------------------------------------------------------------
-- | Wrapper types
+-- Wrapper types
 type AlwaysX = Always (X ())
@ -233,7 +221,7 @@ type SometimesIO = Sometimes (FIO ())
 type Feature a = Either (Sometimes a) (Always a)
 --------------------------------------------------------------------------------
-- | Feature declaration
+-- Feature declaration
 -- | Feature that is guaranteed to work
 -- This is composed of sub-features that are tested in order, and if all fail
@ -241,17 +229,20 @@ type Feature a = Either (Sometimes a) (Always a)
 data Always a = Always T.Text (Always_ a)
 -- | Feature that is guaranteed to work (inner data)
-data Always_ a = Option (SubfeatureRoot a) (Always_ a)
+data Always_ a
  = Option (SubfeatureRoot a) (Always_ a)
  | Always_ (FallbackRoot a)
 -- | Root of a fallback action for an always
 -- This may either be a lone action or a function that depends on the results
 -- from other Always features.
-data FallbackRoot a = FallbackAlone a
+data FallbackRoot a
  = FallbackAlone a
  | forall p. FallbackTree (p -> a) (FallbackStack p)
 -- | Always features that are used as a payload for a fallback action
-data FallbackStack p = FallbackBottom (Always p)
+data FallbackStack p
  = FallbackBottom (Always p)
  | forall x y. FallbackStack (x -> y -> p) (Always x) (FallbackStack y)
 -- | Feature that might not be present
@ -276,14 +267,15 @@ type SubfeatureRoot a = Subfeature (Root a)
 -- | An action and its dependencies
 -- May be a plain old monad or be DBus-dependent, in which case a client is
 -- needed
-data Root a = forall p. IORoot (p -> a) (IOTree p)
+data Root a
  = forall p. IORoot (p -> a) (IOTree p)
  | IORoot_ a IOTree_
  | forall c p. SafeClient c => DBusRoot (p -> c -> a) (DBusTree c p) (Maybe c)
  | forall c. SafeClient c => DBusRoot_ (c -> a) (DBusTree_ c) (Maybe c)
 -- | The dependency tree with rule to merge results when needed
-data Tree d d_ p =
+data Tree d d_ p
-  forall x y. And12 (x -> y -> p) (Tree d d_ x) (Tree d d_ y)
+  = forall x y. And12 (x -> y -> p) (Tree d d_ x) (Tree d d_ y)
  | And1 (Tree d d_ p) (Tree_ d_)
  | And2 (Tree_ d_) (Tree d d_ p)
  | Or (Tree d d_ p) (Tree d d_ p)
@ -294,36 +286,41 @@ data Tree_ d = And_ (Tree_ d) (Tree_ d) | Or_ (Tree_ d) (Tree_ d) | Only_ d
 -- | Shorthand tree types for lazy typers
 type IOTree p = Tree IODependency IODependency_ p
 type DBusTree c p = Tree IODependency (DBusDependency_ c) p
 type IOTree_ = Tree_ IODependency_
 type DBusTree_ c = Tree_ (DBusDependency_ c)
 -- | A dependency that only requires IO to evaluate (with payload)
-data IODependency p =
+data IODependency p
-  -- an IO action that yields a payload
+  = -- an IO action that yields a payload
    IORead T.Text [Fulfillment] (FIO (Result p))
-  -- always yields a payload
+  | -- always yields a payload
-  | IOConst p
+    IOConst p
-  -- an always that yields a payload
+  | -- an always that yields a payload
-  | forall a. IOAlways (Always a) (a -> p)
+    forall a. IOAlways (Always a) (a -> p)
-  -- a sometimes that yields a payload
+  | -- a sometimes that yields a payload
-  | forall a. IOSometimes (Sometimes a) (a -> p)
+    forall a. IOSometimes (Sometimes a) (a -> p)
 -- | A dependency pertaining to the DBus
-data DBusDependency_ c = Bus [Fulfillment] BusName
+data DBusDependency_ c
  = Bus [Fulfillment] BusName
  | Endpoint [Fulfillment] BusName ObjectPath InterfaceName DBusMember
  | DBusIO IODependency_
  deriving (Generic)
 -- | A dependency that only requires IO to evaluate (no payload)
-data IODependency_ = IOSystem_ [Fulfillment] SystemDependency
+data IODependency_
  = IOSystem_ [Fulfillment] SystemDependency
  | IOTest_ T.Text [Fulfillment] (FIO (Maybe Msg))
  | forall a. IOSometimes_ (Sometimes a)
 -- | A system component to an IODependency
 -- This name is dumb, but most constructors should be obvious
-data SystemDependency =
+data SystemDependency
-  Executable Bool FilePath
+  = Executable Bool FilePath
  | AccessiblePath FilePath Bool Bool
  | Systemd UnitType T.Text
  | Process T.Text
@ -333,7 +330,8 @@ data SystemDependency =
 data UnitType = SystemUnit | UserUnit deriving (Eq, Show, Generic)
 -- | Wrapper type to describe and endpoint
-data DBusMember = Method_ MemberName
+data DBusMember
  = Method_ MemberName
  | Signal_ MemberName
  | Property_ T.Text
  deriving (Eq, Show, Generic)
@ -345,7 +343,7 @@ data Fulfillment = Package ArchPkg T.Text deriving (Eq, Show, Ord)
 data ArchPkg = Official | AUR | Custom deriving (Eq, Show, Generic, Ord)
 --------------------------------------------------------------------------------
-- | Tested dependency tree
+-- Tested dependency tree
 --
 -- The main reason I need this is so I have a "result" I can convert to JSON
 -- and dump on the CLI (unless there is a way to make Aeson work inside an IO)
@ -357,7 +355,8 @@ data Msg = Msg LogLevel T.Text
 data FMsg = FMsg T.Text (Maybe T.Text) Msg
 -- | Tested Always feature
-data PostAlways a = Primary (SubfeaturePass a) [SubfeatureFail] (Always_ a)
+data PostAlways a
  = Primary (SubfeaturePass a) [SubfeatureFail] (Always_ a)
  | Fallback a [SubfeatureFail]
 -- | Tested Sometimes feature
@ -382,7 +381,7 @@ addMsgs (PostPass a ms) ms' = PostPass a $ ms ++ ms'
 data PostFail = PostFail [Msg] | PostMissing Msg
 --------------------------------------------------------------------------------
-- | Configuration
+-- Configuration
 type FIO a = RIO DepStage a
@ -393,10 +392,10 @@ data DepStage = DepStage
  }
 instance HasLogFunc DepStage where
-  logFuncL = lens dsLogFun (\x y -> x { dsLogFun = y })
+  logFuncL = lens dsLogFun (\x y -> x {dsLogFun = y})
 instance HasProcessContext DepStage where
-  processContextL = lens dsProcCxt (\x y -> x { dsProcCxt = y })
+  processContextL = lens dsProcCxt (\x y -> x {dsProcCxt = y})
 data XParams = XParams
  { xpLogLevel :: LogLevel
@ -434,34 +433,48 @@ data XPFeatures = XPFeatures
  }
 instance FromJSON XPFeatures where
-  parseJSON = withObject "features" $ \o -> XPFeatures
+  parseJSON = withObject "features" $ \o ->
-    <$> o .:+ "optimus"
+    XPFeatures
-    <*> o .:+ "virtualbox"
+      <$> o
-    <*> o .:+ "xsane"
+      .:+ "optimus"
-    <*> o .:+ "ethernet"
+      <*> o
-    <*> o .:+ "wireless"
+      .:+ "virtualbox"
-    <*> o .:+ "vpn"
+      <*> o
-    <*> o .:+ "bluetooth"
+      .:+ "xsane"
-    <*> o .:+ "intel_backlight"
+      <*> o
-    <*> o .:+ "clevo_backlight"
+      .:+ "ethernet"
-    <*> o .:+ "battery"
+      <*> o
-    <*> o .:+ "f5vpn"
+      .:+ "wireless"
      <*> o
      .:+ "vpn"
      <*> o
      .:+ "bluetooth"
      <*> o
      .:+ "intel_backlight"
      <*> o
      .:+ "clevo_backlight"
      <*> o
      .:+ "battery"
      <*> o
      .:+ "f5vpn"
 defParams :: XParams
-defParams = XParams
+defParams =
  XParams
    { xpLogLevel = LevelError
    , xpFeatures = defXPFeatures
    }
 defXPFeatures :: XPFeatures
-defXPFeatures = XPFeatures
+defXPFeatures =
  XPFeatures
    { xpfOptimus = False
    , xpfVirtualBox = False
    , xpfXSANE = False
    , xpfEthernet = False
    , xpfWireless = False
-  -- TODO this might be broken down into different flags (expressvpn, etc)
+    , -- TODO this might be broken down into different flags (expressvpn, etc)
-  , xpfVPN = False
+      xpfVPN = False
    , xpfBluetooth = False
    , xpfIntelBacklight = False
    , xpfClevoBacklight = False
@ -476,7 +489,8 @@ getParams = do
  p <- getParamFile
  maybe (return defParams) decodeYaml p
  where
-    decodeYaml p = either (\e -> print e >> return defParams) return
+    decodeYaml p =
      either (\e -> print e >> return defParams) return
        =<< decodeFileEither p
 getParamFile :: IO (Maybe FilePath)
@ -495,16 +509,18 @@ getParamFile = do
 (.:+) :: Object -> String -> Parser Bool
 (.:+) o n = o .:? fromString n .!= False
-infix .:+
+infix 9 .:+
 --------------------------------------------------------------------------------
-- | Testing pipeline
+-- Testing pipeline
 evalSometimesMsg :: Sometimes a -> FIO (Either [FMsg] (a, [FMsg]))
 evalSometimesMsg (Sometimes n u xs) = do
  r <- asks (u . xpFeatures . dsParams)
-  if not r then return $ Left [dis n] else do
+  if not r
-    PostSometimes { psSuccess = s, psFailed = fs } <- testSometimes xs
+    then return $ Left [dis n]
    else do
      PostSometimes {psSuccess = s, psFailed = fs} <- testSometimes xs
      let fs' = failedMsgs n fs
      return $ case s of
        (Just p) -> Right $ second (++ fs') $ passActMsg n p
@ -520,13 +536,13 @@ evalAlwaysMsg (Always n x) = do
    (Fallback act fs) -> (act, failedMsgs n fs)
 passActMsg :: T.Text -> SubfeaturePass a -> (a, [FMsg])
-passActMsg fn Subfeature { sfData = PostPass a ws, sfName = n } = (a, fmap (FMsg fn (Just n)) ws)
+passActMsg fn Subfeature {sfData = PostPass a ws, sfName = n} = (a, fmap (FMsg fn (Just n)) ws)
 failedMsgs :: T.Text -> [SubfeatureFail] -> [FMsg]
 failedMsgs n = concatMap (failedMsg n)
 failedMsg :: T.Text -> SubfeatureFail -> [FMsg]
-failedMsg fn Subfeature { sfData = d, sfName = n } = case d of
+failedMsg fn Subfeature {sfData = d, sfName = n} = case d of
  (PostFail es) -> f es
  (PostMissing e) -> f [e]
  where
@ -538,7 +554,7 @@ testAlways = go []
    go failed (Option fd next) = do
      r <- testSubfeature fd
      case r of
-        (Left l)     -> go (l:failed) next
+        (Left l) -> go (l : failed) next
        (Right pass) -> return $ Primary pass failed next
    go failed (Always_ ar) = (`Fallback` failed) <$> evalFallbackRoot ar
@ -557,17 +573,17 @@ testSometimes :: Sometimes_ a -> FIO (PostSometimes a)
 testSometimes = go (PostSometimes Nothing [])
  where
    go ts [] = return ts
-    go ts (x:xs) = do
+    go ts (x : xs) = do
      sf <- testSubfeature x
      case sf of
-        (Left l)     -> go (ts { psFailed = l:psFailed ts }) xs
+        (Left l) -> go (ts {psFailed = l : psFailed ts}) xs
-        (Right pass) -> return $ ts { psSuccess = Just pass }
+        (Right pass) -> return $ ts {psSuccess = Just pass}
 testSubfeature :: SubfeatureRoot a -> FIO (Either SubfeatureFail (SubfeaturePass a))
-testSubfeature sf@Subfeature{ sfData = t } = do
+testSubfeature sf@Subfeature {sfData = t} = do
  t' <- testRoot t
  -- monomorphism restriction :(
-  return $ bimap (\n -> sf { sfData = n }) (\n -> sf { sfData = n }) t'
+  return $ bimap (\n -> sf {sfData = n}) (\n -> sf {sfData = n}) t'
 testRoot :: Root a -> FIO (Either PostFail (PostPass a))
 testRoot r = do
@ -576,8 +592,11 @@ testRoot r = do
    (IORoot_ a t) -> go_ a testIODep_ t
    (DBusRoot a t (Just cl)) -> go (`a` cl) (testDBusDep_ cl) testIODep t
    (DBusRoot_ a t (Just cl)) -> go_ (a cl) (testDBusDep_ cl) t
-    _                         -> return $ Left $ PostMissing
+    _ ->
-                                 $ Msg LevelError "client not available"
+      return $
        Left $
          PostMissing $
            Msg LevelError "client not available"
  where
    -- rank N polymorphism is apparently undecidable...gross
    go a f_ (f :: forall q. d q -> FIO (MResult q)) t =
@ -585,13 +604,15 @@ testRoot r = do
    go_ a f_ t = bimap PostFail (PostPass a) <$> testTree_ f_ t
 --------------------------------------------------------------------------------
-- | Payloaded dependency testing
+-- Payloaded dependency testing
 type Result p = Either [Msg] (PostPass p)
 type MResult p = Memoized (Result p)
-testTree :: forall d d_ p. (d_ -> FIO MResult_)
+testTree
  :: forall d d_ p
   . (d_ -> FIO MResult_)
  -> (forall q. d q -> FIO (MResult q))
  -> Tree d d_ p
  -> FIO (Either [Msg] (PostPass p))
@ -622,18 +643,22 @@ testIODep d = memoizeMVar $ case d of
  -- succeed, which kinda makes this pointless. The only reason I would want
  -- this is if I want to have a built-in logic to "choose" a payload to use in
  -- building a higher-level feature
-  IOAlways a f     -> Right . uncurry PostPass
+  IOAlways a f ->
    Right
      . uncurry PostPass
      -- TODO this is wetter than Taco Bell shit
-    . bimap f (fmap stripMsg) <$> evalAlwaysMsg a
+      . bimap f (fmap stripMsg)
-  IOSometimes x f  -> bimap (fmap stripMsg) (uncurry PostPass . bimap f (fmap stripMsg))
+      <$> evalAlwaysMsg a
  IOSometimes x f ->
    bimap (fmap stripMsg) (uncurry PostPass . bimap f (fmap stripMsg))
      <$> evalSometimesMsg x
 stripMsg :: FMsg -> Msg
 stripMsg (FMsg _ _ m) = m
 --------------------------------------------------------------------------------
 -- | Standalone dependency testing
 -- | Standalone dependency testing
 type Result_ = Either [Msg] [Msg]
 type MResult_ = Memoized Result_
@ -652,14 +677,17 @@ testIODep_ d = memoizeMVar $ testIODepNoCache_ d
 testIODepNoCache_ :: IODependency_ -> FIO Result_
 testIODepNoCache_ (IOSystem_ _ s) = readResult_ <$> testSysDependency s
 testIODepNoCache_ (IOTest_ _ _ t) = readResult_ <$> t
-testIODepNoCache_ (IOSometimes_ x) = bimap (fmap stripMsg) (fmap stripMsg . snd)
+testIODepNoCache_ (IOSometimes_ x) =
  bimap (fmap stripMsg) (fmap stripMsg . snd)
    <$> evalSometimesMsg x
 --------------------------------------------------------------------------------
 -- | System Dependency Testing
 -- | System Dependency Testing
 testSysDependency :: SystemDependency -> FIO (Maybe Msg)
-testSysDependency (Executable sys bin) = io $ maybe (Just msg) (const Nothing)
+testSysDependency (Executable sys bin) =
  io $
    maybe (Just msg) (const Nothing)
      <$> findExecutable bin
  where
    msg = Msg LevelError $ T.unwords [e, "executable", singleQuote $ T.pack bin, "not found"]
@ -668,8 +696,9 @@ testSysDependency (Systemd t n) = shellTest "systemctl" args msg
  where
    msg = T.unwords ["systemd", unitType t, "unit", singleQuote n, "not found"]
    args = ["--user" | t == UserUnit] ++ ["status", n]
-testSysDependency (Process n) = shellTest "pidof" [n]
+testSysDependency (Process n) =
-  $ T.unwords ["Process", singleQuote n, "not found"]
+  shellTest "pidof" [n] $
    T.unwords ["Process", singleQuote n, "not found"]
 testSysDependency (AccessiblePath p r w) = io $ permMsg <$> getPermissionsSafe p
  where
    testPerm False _ _ = Nothing
@ -696,7 +725,7 @@ unitType SystemUnit = "system"
 unitType UserUnit = "user"
 --------------------------------------------------------------------------------
-- | Font testers
+-- Font testers
 --
 -- Make a special case for these since we end up testing the font alot, and it
 -- would be nice if I can cache them.
@ -706,7 +735,7 @@ fontAlways n fam ful = always1 n (fontFeatureName fam) root fallbackFont
  where
    root = IORoot id $ fontTree fam ful
-fontSometimes :: T.Text -> T.Text -> [Fulfillment]-> Sometimes FontBuilder
+fontSometimes :: T.Text -> T.Text -> [Fulfillment] -> Sometimes FontBuilder
 fontSometimes n fam ful = sometimes1 n (fontFeatureName fam) root
  where
    root = IORoot id $ fontTree fam ful
@ -736,7 +765,7 @@ fontTestName fam = T.unwords ["test if font", singleQuote fam, "exists"]
 -- testFont = liftIO . testFont'
 testFont :: T.Text -> FIO (Result FontBuilder)
-testFont fam = maybe pass (Left . (:[])) <$> shellTest "fc-list" args msg
+testFont fam = maybe pass (Left . (: [])) <$> shellTest "fc-list" args msg
  where
    msg = T.unwords ["font family", qFam, "not found"]
    args = [qFam]
@ -744,7 +773,7 @@ testFont fam = maybe pass (Left . (:[])) <$> shellTest "fc-list" args msg
    pass = Right $ PostPass (buildFont $ Just fam) []
 --------------------------------------------------------------------------------
-- | Network Testers
+-- Network Testers
 --
 -- ASSUME that the system uses systemd in which case ethernet interfaces always
 -- start with "en" and wireless interfaces always start with "wl"
@ -762,7 +791,8 @@ isEthernet :: T.Text -> Bool
 isEthernet = T.isPrefixOf "en"
 listInterfaces :: IO [T.Text]
-listInterfaces = fromRight []
+listInterfaces =
  fromRight []
    <$> tryIOError (fmap T.pack <$> listDirectory sysfsNet)
 sysfsNet :: FilePath
@ -777,16 +807,20 @@ readInterface n f = IORead n [] go
      ns <- filter f <$> listInterfaces
      case ns of
        [] -> return $ Left [Msg LevelError "no interfaces found"]
-        (x:xs) -> do
+        (x : xs) -> do
-          return $ Right $ PostPass x
+          return $
-            $ fmap (Msg LevelWarn . T.append "ignoring extra interface: ") xs
+            Right $
              PostPass x $
                fmap (Msg LevelWarn . T.append "ignoring extra interface: ") xs
 --------------------------------------------------------------------------------
-- | Misc testers
+-- Misc testers
 socketExists :: T.Text -> [Fulfillment] -> IO FilePath -> IODependency_
-socketExists n ful = IOTest_ (T.unwords ["test if", n, "socket exists"]) ful
+socketExists n ful =
-  . io . socketExists'
+  IOTest_ (T.unwords ["test if", n, "socket exists"]) ful
    . io
    . socketExists'
 socketExists' :: IO FilePath -> IO (Maybe Msg)
 socketExists' getPath = do
@ -799,7 +833,7 @@ socketExists' getPath = do
    toErr = Just . Msg LevelError
 --------------------------------------------------------------------------------
-- | DBus Dependency Testing
+-- DBus Dependency Testing
 introspectInterface :: InterfaceName
 introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
@ -815,10 +849,13 @@ testDBusDepNoCache_ cl (Bus _ bus) = io $ do
  ret <- callMethod cl queryBus queryPath queryIface queryMem
  return $ case ret of
    Left e -> Left [Msg LevelError e]
-        Right b -> let ns = bodyGetNames b in
+    Right b ->
-          if bus' `elem` ns then Right []
+      let ns = bodyGetNames b
-          else Left [
+       in if bus' `elem` ns
-            Msg LevelError $ T.unwords ["name", singleQuote bus', "not found on dbus"]
+            then Right []
            else
              Left
                [ Msg LevelError $ T.unwords ["name", singleQuote bus', "not found on dbus"]
                ]
  where
    bus' = T.pack $ formatBusName bus
@ -828,19 +865,23 @@ testDBusDepNoCache_ cl (Bus _ bus) = io $ do
    queryMem = memberName_ "ListNames"
    bodyGetNames [v] = fromMaybe [] $ fromVariant v :: [T.Text]
    bodyGetNames _ = []
 testDBusDepNoCache_ cl (Endpoint _ busname objpath iface mem) = io $ do
  ret <- callMethod cl busname objpath introspectInterface introspectMethod
  return $ case ret of
    Left e -> Left [Msg LevelError e]
    Right body -> procBody body
  where
-    procBody body = let res = findMem =<< I.parseXML objpath =<< fromVariant
+    procBody body =
-                          =<< listToMaybe body in
+      let res =
-      case res of
+            findMem
              =<< I.parseXML objpath
              =<< fromVariant
              =<< listToMaybe body
       in case res of
            Just True -> Right []
            _ -> Left [Msg LevelError $ fmtMsg' mem]
-    findMem = fmap (matchMem mem)
+    findMem =
      fmap (matchMem mem)
        . find (\i -> I.interfaceName i == iface)
        . I.objectInterfaces
    matchMem (Method_ n) = elemMember n I.methodName I.interfaceMethods
@ -850,7 +891,8 @@ testDBusDepNoCache_ cl (Endpoint _ busname objpath iface mem) = io $ do
    fmtMem (Method_ n) = T.unwords ["method", singleQuote (T.pack $ formatMemberName n)]
    fmtMem (Signal_ n) = T.unwords ["signal", singleQuote (T.pack $ formatMemberName n)]
    fmtMem (Property_ n) = T.unwords ["property", singleQuote n]
-    fmtMsg' m = T.unwords
+    fmtMsg' m =
      T.unwords
        [ "could not find"
        , fmtMem m
        , "on interface"
@ -858,11 +900,10 @@ testDBusDepNoCache_ cl (Endpoint _ busname objpath iface mem) = io $ do
        , "on bus"
        , T.pack $ formatBusName busname
        ]
 testDBusDepNoCache_ _ (DBusIO i) = testIODepNoCache_ i
 --------------------------------------------------------------------------------
-- | IO Lifting functions
+-- IO Lifting functions
 ioSometimes :: MonadIO m => Sometimes (IO a) -> Sometimes (m a)
 ioSometimes (Sometimes n t xs) = Sometimes n t $ fmap ioSubfeature xs
@ -879,7 +920,7 @@ ioFallbackRoot (FallbackAlone a)  = FallbackAlone $ io a
 ioFallbackRoot (FallbackTree a s) = FallbackTree (io . a) s
 ioSubfeature :: MonadIO m => SubfeatureRoot (IO a) -> SubfeatureRoot (m a)
-ioSubfeature sf = sf { sfData = ioRoot $ sfData sf }
+ioSubfeature sf = sf {sfData = ioRoot $ sfData sf}
 ioRoot :: MonadIO m => Root (IO a) -> Root (m a)
 ioRoot (IORoot a t) = IORoot (io . a) t
@ -888,15 +929,19 @@ ioRoot (DBusRoot a t cl)  = DBusRoot (\p c -> io $ a p c) t cl
 ioRoot (DBusRoot_ a t cl) = DBusRoot_ (io . a) t cl
 --------------------------------------------------------------------------------
-- | Feature constructors
+-- Feature constructors
 sometimes1_ :: XPQuery -> T.Text -> T.Text -> Root a -> Sometimes a
-sometimes1_ x fn n t = Sometimes fn x
+sometimes1_ x fn n t =
-  [Subfeature{ sfData = t, sfName = n }]
+  Sometimes
    fn
    x
    [Subfeature {sfData = t, sfName = n}]
 always1_ :: T.Text -> T.Text -> Root a -> a -> Always a
-always1_ fn n t x = Always fn
+always1_ fn n t x =
-  $ Option (Subfeature{ sfData = t, sfName = n }) (Always_ $ FallbackAlone x)
+  Always fn $
    Option (Subfeature {sfData = t, sfName = n}) (Always_ $ FallbackAlone x)
 sometimes1 :: T.Text -> T.Text -> Root a -> Sometimes a
 sometimes1 = sometimes1_ (const True)
@ -910,22 +955,49 @@ sometimesIO_ fn n t x = sometimes1 fn n $ IORoot_ x t
 sometimesIO :: T.Text -> T.Text -> IOTree p -> (p -> a) -> Sometimes a
 sometimesIO fn n t x = sometimes1 fn n $ IORoot x t
-sometimesExe :: MonadIO m => T.Text -> T.Text -> [Fulfillment] -> Bool
+sometimesExe
-  -> FilePath -> Sometimes (m ())
+  :: MonadIO m
  => T.Text
  -> T.Text
  -> [Fulfillment]
  -> Bool
  -> FilePath
  -> Sometimes (m ())
 sometimesExe fn n ful sys path = sometimesExeArgs fn n ful sys path []
-sometimesExeArgs :: MonadIO m => T.Text -> T.Text -> [Fulfillment] -> Bool
+sometimesExeArgs
-  -> FilePath -> [T.Text] -> Sometimes (m ())
+  :: MonadIO m
  => T.Text
  -> T.Text
  -> [Fulfillment]
  -> Bool
  -> FilePath
  -> [T.Text]
  -> Sometimes (m ())
 sometimesExeArgs fn n ful sys path args =
  sometimesIO_ fn n (Only_ (IOSystem_ ful $ Executable sys path)) $ spawnCmd path args
-sometimesDBus :: SafeClient c => Maybe c -> T.Text -> T.Text
+sometimesDBus
-  -> Tree_ (DBusDependency_ c) -> (c -> a) -> Sometimes a
+  :: SafeClient c
  => Maybe c
  -> T.Text
  -> T.Text
  -> Tree_ (DBusDependency_ c)
  -> (c -> a)
  -> Sometimes a
 sometimesDBus c fn n t x = sometimes1 fn n $ DBusRoot_ x t c
-sometimesEndpoint :: (SafeClient c, MonadIO m) => T.Text -> T.Text
+sometimesEndpoint
-  -> [Fulfillment] -> BusName -> ObjectPath -> InterfaceName -> MemberName
+  :: (SafeClient c, MonadIO m)
-  -> Maybe c -> Sometimes (m ())
+  => T.Text
  -> T.Text
  -> [Fulfillment]
  -> BusName
  -> ObjectPath
  -> InterfaceName
  -> MemberName
  -> Maybe c
  -> Sometimes (m ())
 sometimesEndpoint fn name ful busname path iface mem cl =
  sometimesDBus cl fn name deps cmd
  where
@ -933,7 +1005,7 @@ sometimesEndpoint fn name ful busname path iface mem cl =
    cmd c = io $ void $ callMethod c busname path iface mem
 --------------------------------------------------------------------------------
-- | Dependency Tree Constructors
+-- Dependency Tree Constructors
 listToAnds :: d -> [d] -> Tree_ d
 listToAnds i = foldr (And_ . Only_) (Only_ i)
@ -950,7 +1022,7 @@ voidResult (Right (PostPass _ ws)) = Right ws
 voidRead :: Result p -> Maybe Msg
 voidRead (Left []) = Just $ Msg LevelError "unspecified error"
-voidRead (Left (e:_)) = Just e
+voidRead (Left (e : _)) = Just e
 voidRead (Right _) = Nothing
 readResult_ :: Maybe Msg -> Result_
@ -958,7 +1030,7 @@ readResult_ (Just w) = Left [w]
 readResult_ _ = Right []
 --------------------------------------------------------------------------------
-- | IO Dependency Constructors
+-- IO Dependency Constructors
 exe :: Bool -> [Fulfillment] -> FilePath -> IODependency_
 exe b ful = IOSystem_ ful . Executable b
@ -994,12 +1066,12 @@ process :: [Fulfillment] -> T.Text -> IODependency_
 process ful = IOSystem_ ful . Process
 --------------------------------------------------------------------------------
-- | Dependency data for JSON
+-- Dependency data for JSON
 type DependencyData = [Fulfillment]
 dataSubfeatureRoot :: SubfeatureRoot a -> DependencyData
-dataSubfeatureRoot Subfeature { sfData = r } = dataRoot r
+dataSubfeatureRoot Subfeature {sfData = r} = dataRoot r
 dataRoot :: Root a -> DependencyData
 dataRoot (IORoot _ t) = dataTree dataIODependency dataIODependency_ t
@ -1007,8 +1079,12 @@ dataRoot (IORoot_ _ t)     = dataTree_ dataIODependency_ t
 dataRoot (DBusRoot _ t _) = dataTree dataIODependency dataDBusDependency t
 dataRoot (DBusRoot_ _ t _) = dataTree_ dataDBusDependency t
-dataTree :: forall d d_ p. (forall q. d q -> DependencyData)
+dataTree
-  -> (d_ -> DependencyData) -> Tree d d_ p -> DependencyData
+  :: forall d d_ p
   . (forall q. d q -> DependencyData)
  -> (d_ -> DependencyData)
  -> Tree d d_ p
  -> DependencyData
 dataTree f f_ = go
  where
    go :: forall q. Tree d d_ q -> DependencyData
@ -1045,8 +1121,7 @@ dataDBusDependency d = case d of
  (DBusIO x) -> dataIODependency_ x
 --------------------------------------------------------------------------------
-- | JSON formatting
+-- formatting
 bracket :: T.Text -> T.Text
 bracket s = T.concat ["[", s, "]"]
--- 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,23 +15,19 @@ module XMonad.Internal.Command.DMenu
  , runBTMenu
  , runShowKeys
  , runAutorandrMenu
-  ) where
+  )
-
+where
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 import DBus
-
+import Data.Internal.DBus
 import Data.Internal.Dependency
 import Graphics.X11.Types
 import qualified RIO.Text as T
 import System.Directory
  ( XdgDirectory (..)
  , getXdgDirectory
  )
 import System.IO
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
@ -40,7 +36,7 @@ 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"
+          ++ "--"
          : themeArgs "#999933"
          ++ myDmenuMatchingArgs
 -- TODO test that bluetooth interface exists
 runBTMenu :: SometimesX
-runBTMenu = Sometimes "bluetooth selector" xpfBluetooth
+runBTMenu =
  Sometimes
    "bluetooth selector"
    xpfBluetooth
    [Subfeature (IORoot_ cmd tree) "rofi bluetooth"]
  where
-    cmd = spawnCmd myDmenuBluetooth $ "-c":themeArgs "#0044bb"
+    cmd = spawnCmd myDmenuBluetooth $ "-c" : themeArgs "#0044bb"
    tree = dmenuTree $ Only_ $ sysExe [] myDmenuBluetooth
 runVPNMenu :: SometimesX
-runVPNMenu = Sometimes "VPN selector" xpfVPN
+runVPNMenu =
  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 =
  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,44 +168,60 @@ 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 =
      listToAnds
        dmenuDep
        [ sysExe clipboardPkgs myClipboardManager
        , process [] $ T.pack myClipboardManager
        ]
-    args = [ "-modi", "\"clipboard:greenclip print\""
+    args =
-           , "-show", "clipboard"
+      [ "-modi"
-           , "-run-command", "'{cmd}'"
+      , "\"clipboard:greenclip print\""
-           ] ++ themeArgs "#00c44e"
+      , "-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 =
  Subfeature
    { sfName = "keyboard shortcut menu"
    , sfData = IORoot_ showKeys $ Only_ dmenuDep
    }
@ -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,28 +32,23 @@ module XMonad.Internal.Command.Desktop
  , runNotificationCloseAll
  , runNotificationHistory
  , runNotificationContext
  -- daemons
  , runNetAppDaemon
  -- packages
  , networkManagerPkgs
-  ) where
+  )
-
+where
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 import DBus
-
+import Data.Internal.DBus
 import Data.Internal.Dependency
 import RIO
 import RIO.FilePath
 import qualified RIO.Process as P
 import qualified RIO.Text as T
 import System.Directory
 import System.Environment
 import System.Posix.User
 import XMonad.Actions.Volume
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.DBus.Common
@ -63,7 +57,7 @@ import           XMonad.Internal.Shell       as S
 import XMonad.Operations
 --------------------------------------------------------------------------------
-- | My Executables
+-- My Executables
 myTerm :: FilePath
 myTerm = "urxvt"
@ -96,10 +90,11 @@ myNotificationCtrl :: FilePath
 myNotificationCtrl = "dunstctl"
 --------------------------------------------------------------------------------
-- | Packages
+-- Packages
 myTermPkgs :: [Fulfillment]
-myTermPkgs = [ Package Official "rxvt-unicode"
+myTermPkgs =
  [ Package Official "rxvt-unicode"
  , Package Official "urxvt-perls"
  ]
@ -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 =
      S.spawn $
        fmtCmd "tmux" ["has-session"]
          #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
-      #!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
+          #!|| 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 =
      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,11 +261,14 @@ 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 =
  Sometimes
    "network applet"
    xpfVPN
    [Subfeature (DBusRoot_ cmd tree cl) "NM-applet"]
  where
    tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
@ -256,35 +276,46 @@ runNetAppDaemon cl = Sometimes "network applet" xpfVPN
    cmd _ = P.proc "nm-applet" [] (P.startProcess . P.setCreateGroup True)
 runToggleBluetooth :: Maybe SysClient -> SometimesX
-runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth
+runToggleBluetooth cl =
  Sometimes
    "bluetooth toggle"
    xpfBluetooth
    [Subfeature (DBusRoot_ cmd tree cl) "bluetoothctl"]
  where
    tree = And_ (Only_ $ DBusIO $ sysExe bluetoothPkgs myBluetooth) (Only_ $ Bus [] btBus)
-    cmd _ = S.spawn
+    cmd _ =
-      $ fmtCmd myBluetooth ["show"]
+      S.spawn $
        fmtCmd myBluetooth ["show"]
          #!| "grep -q \"Powered: no\""
          #!&& "a=on"
          #!|| "a=off"
          #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
-      #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
+          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "bluetooth powered $a"}
 runToggleEthernet :: SometimesX
-runToggleEthernet = Sometimes "ethernet toggle" xpfEthernet
+runToggleEthernet =
  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 $
        fmtCmd "nmcli" ["-g", "GENERAL.STATE", "device", "show", iface]
          #!| "grep -q disconnected"
          #!&& "a=connect"
          #!|| "a=disconnect"
          #!>> fmtCmd "nmcli" ["device", "$a", iface]
-      #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed"  }
+          #!&& 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"]
-    #!&& 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"
  "feh"
  (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,23 +23,19 @@ module XMonad.Internal.Command.Power
  , powerPrompt
  , defFontPkgs
  , promptFontDep
-  ) where
+  )
-
+where
 import           Data.Internal.Dependency
 import Data.Either
 import Data.Internal.Dependency
 import qualified Data.Map as M
 import Graphics.X11.Types
 import RIO
 import RIO.FilePath
 import qualified RIO.Process as P
 import qualified RIO.Text as T
 import System.Directory
 import System.IO.Error
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme as XT
@ -49,8 +43,7 @@ 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,26 +148,32 @@ 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.pack myPrimeOffload
          #!&& 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
  = Poweroff
  | Shutdown
  | Hibernate
  | Reboot
@ -202,10 +208,12 @@ 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)
          : map
            (first $ (,) 0)
            [ (xK_p, sendMaybeAction Poweroff)
            , (xK_s, sendMaybeAction Shutdown)
            , (xK_h, sendMaybeAction Hibernate)
--- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
+++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
@ -2,21 +2,19 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Concurrent module to handle events from acpid
+-- Concurrent module to handle events from acpid
 module XMonad.Internal.Concurrent.ACPIEvent
  ( runPowermon
  , runHandleACPI
-  ) where
+  )
 where
 import Data.Internal.Dependency
 import Network.Socket
 import Network.Socket.ByteString
 import RIO
 import qualified RIO.ByteString as B
 import XMonad.Core
 import XMonad.Internal.Command.Power
 import XMonad.Internal.Concurrent.ClientMessage
@ -24,12 +22,13 @@ 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
  = Power
  | Sleep
  | LidClose
  deriving (Eq)
@ -45,18 +44,18 @@ instance Enum ACPIEvent where
  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
  where
    splitLine = B.split space . B.reverse . B.dropWhile (== newline) . B.reverse
@ -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,29 +16,29 @@
 -- much like something from X even though it isn't
 module XMonad.Internal.Concurrent.ClientMessage
-  ( XMsgType(..)
+  ( XMsgType (..)
  , sendXMsg
  , splitXMsg
-  ) where
+  )
 where
 import Data.Char
 import Graphics.X11.Types
 import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Display
 import Graphics.X11.Xlib.Event
 import Graphics.X11.Xlib.Extras
 import Graphics.X11.Xlib.Types
 import RIO hiding (Display)
 --------------------------------------------------------------------------------
-- | 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
  = ACPI
  | Workspace
  | Unknown
  deriving (Eq, Show)
@ -53,13 +53,13 @@ instance Enum XMsgType where
  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,41 +24,35 @@
 -- 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.Reader
-
+import Data.List (deleteBy, find)
-
+import qualified Data.Map as M
 import Data.Maybe
 import Graphics.X11.Types
 import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Display
 import Graphics.X11.Xlib.Event
 import Graphics.X11.Xlib.Extras
 import Graphics.X11.Xlib.Misc
 import Graphics.X11.Xlib.Types
 import RIO hiding
  ( Display
  , display
  )
 import qualified RIO.Set as S
 import System.Process
 import XMonad.Actions.DynamicWorkspaces
 import XMonad.Core
  ( ManageHook
@ -75,8 +69,8 @@ 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
@ -89,7 +83,7 @@ data DynWorkspace = DynWorkspace
  }
 --------------------------------------------------------------------------------
-- | 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
@ -120,22 +114,23 @@ 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
@ -143,28 +138,32 @@ handleEvent MapNotifyEvent { ev_window = w } = do
      -- ASSUMPTION windows will only have one PID at one time
      Just [p] -> let p' = fromIntegral p in void $ async $ withUniquePid p' t
      _ -> return ()
 handleEvent _ = return ()
 withUniquePid :: Pid -> String -> W ()
 withUniquePid pid tag = do
  ps <- asks curPIDs
  pids <- readMVar ps
-  io $ unless (pid `elem` pids) $ bracket_
+  io
    $ unless (pid `elem` pids)
    $ bracket_
      (modifyMVar_ ps (return . S.insert pid))
      (modifyMVar_ ps (return . S.delete pid))
    $ waitUntilExit pid >> sendXMsg Workspace tag
 --------------------------------------------------------------------------------
-- | Launching apps
+-- Launching apps
 -- When launching apps on dymamic workspaces, first check if they are running
 -- and launch if not, then switch to their workspace
 wsOccupied :: Eq a1 => a1 -> W.StackSet a1 l a2 sid sd -> Bool
-wsOccupied tag ws = elem tag $ map W.tag $ filter (isJust . W.stack)
+wsOccupied tag ws =
  elem tag $
    map W.tag $
      filter (isJust . W.stack)
      -- list of all workspaces with windows on them
      -- TODO is there not a better way to do this?
-  $ W.workspace (W.current ws) : W.hidden ws ++ map W.workspace (W.visible ws)
+      $
        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)
@ -197,25 +196,27 @@ doSink = doF $ \s -> case W.stack $ W.workspace $ W.current s of
  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
@ -2,23 +2,21 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 --------------------------------------------------------------------------------
-- | VirtualBox-specific functions
+-- VirtualBox-specific functions
 module XMonad.Internal.Concurrent.VirtualBox
  ( vmExists
  , vmInstanceConfig
  , qual
-  ) where
+  )
 where
 import Data.Internal.Dependency
 import           Text.XML.Light
 import RIO hiding (try)
 import RIO.Directory
 import RIO.FilePath
 import qualified RIO.Text as T
-
+import Text.XML.Light
 import XMonad.Internal.Shell
 vmExists :: T.Text -> IO (Maybe Msg)
@ -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 =
      findAttr (unqual "defaultMachineFolder")
        =<< findChild (qual e "SystemProperties")
        =<< findChild (qual e "Global") e
 qual :: Element -> String -> QName
-qual e n = (elName e) { qName = n }
+qual e n = (elName e) {qName = n}
 vmConfig :: IO FilePath
 vmConfig = getXdgDirectory XdgConfig "VirtualBox/VirtualBox.xml"
--- 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 DBus
 import Data.Int (Int32)
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import           DBus
 import RIO.FilePath
 import XMonad.Internal.DBus.Brightness.Common
 import XMonad.Internal.IO
 --------------------------------------------------------------------------------
-- | 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,7 +90,8 @@ interface :: InterfaceName
 interface = interfaceName_ "org.xmonad.Brightness"
 clevoKeyboardConfig :: BrightnessConfig RawBrightness Brightness
-clevoKeyboardConfig = BrightnessConfig
+clevoKeyboardConfig =
  BrightnessConfig
    { bcMin = minBrightness
    , bcMax = maxBrightness
    , bcInc = incBrightness
@ -107,7 +105,7 @@ clevoKeyboardConfig = BrightnessConfig
    }
 --------------------------------------------------------------------------------
-- | 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           Data.Int                    (Int32)
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 import DBus
 import DBus.Client
 import qualified DBus.Introspection as I
-
+import Data.Int (Int32)
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import qualified RIO.Text as T
 import XMonad.Core (io)
 import XMonad.Internal.DBus.Common
 --------------------------------------------------------------------------------
-- | External API
+-- External API
 --
 -- Define four methods to increase, decrease, maximize, or minimize the
 -- brightness. These methods will all return the current brightness as a 32-bit
@ -56,7 +53,10 @@ 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
@ -68,34 +68,48 @@ brightnessControls q bc cl =
  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
 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 =
      matchAny
        { matchPath = Just p
        , 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,7 +122,10 @@ 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
    ses
    (bcPath bc)
    defaultInterface
      { interfaceName = bcInterface bc
      , interfaceMethods =
          [ autoMethod' memMax bcMax
@ -120,11 +137,11 @@ exportBrightnessControls' bc cl = io $ do
      , interfaceSignals = [sig]
      }
  where
-    sig = I.Signal
+    sig =
      I.Signal
        { I.signalName = memCur
        , I.signalArgs =
-        [
+            [ I.SignalArg
          I.SignalArg
                { I.signalArgName = "brightness"
                , I.signalArgType = TypeInt32
                }
@ -132,16 +149,28 @@ exportBrightnessControls' bc cl = io $ do
        }
 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
  -> BrightnessConfig a b
  -> T.Text
  -> MemberName
  -> SometimesX
 callBacklight
  q
  cl
  BrightnessConfig
    { bcPath = p
    , bcInterface = i
-                                    , bcName = n } controlName m =
+    , 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
@ -152,7 +181,7 @@ bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
 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 DBus
 import Data.Int (Int32)
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import           DBus
 import RIO.FilePath
 import XMonad.Internal.DBus.Brightness.Common
 import XMonad.Internal.IO
 --------------------------------------------------------------------------------
-- | 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,7 +73,8 @@ interface :: InterfaceName
 interface = interfaceName_ "org.xmonad.Brightness"
 intelBacklightConfig :: BrightnessConfig RawBrightness Brightness
-intelBacklightConfig = BrightnessConfig
+intelBacklightConfig =
  BrightnessConfig
    { bcMin = minBrightness
    , bcMax = maxBrightness
    , bcInc = incBrightness
@ -89,7 +88,7 @@ intelBacklightConfig = BrightnessConfig
    }
 --------------------------------------------------------------------------------
-- | 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,7 +7,8 @@ module XMonad.Internal.DBus.Common
  , notifyBus
  , notifyPath
  , networkManagerBus
-  ) where
+  )
 where
 import DBus
@ -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,16 +15,14 @@ module XMonad.Internal.DBus.Control
  , withDBusClient_
  , disconnect
  , dbusExporters
-  ) where
+  )
 where
 import Control.Monad
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 import DBus
 import DBus.Client
-
+import Data.Internal.DBus
 import Data.Internal.Dependency
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import XMonad.Internal.DBus.Brightness.IntelBacklight
 import XMonad.Internal.DBus.Common
@ -41,7 +39,7 @@ 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,10 +71,12 @@ 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 == NamePrimaryOwner = Nothing
        | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
        | res == NameInQueue
-            || res == NameExists = Just $ "another process owns " ++ xn
+            || res == NameExists =
            Just $ "another process owns " ++ xn
        | otherwise = Just $ "unknown error when requesting " ++ xn
  forM_ msg putStrLn
  where
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@ -1,7 +1,7 @@
 {-# 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.
@ -9,14 +9,11 @@
 module XMonad.Internal.DBus.Removable (runRemovableMon) where
 import Control.Monad
-
+import DBus
 import DBus.Client
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import Data.Map.Strict (Map, member)
 import           DBus
 import           DBus.Client
 import XMonad.Core (io)
 import XMonad.Internal.Command.Desktop
@ -51,7 +48,8 @@ driveRemovedSound :: FilePath
 driveRemovedSound = "smb_pipe.wav"
 ruleUdisks :: MatchRule
-ruleUdisks = matchAny
+ruleUdisks =
  matchAny
    { matchPath = Just path
    , matchInterface = Just interface
    }
@ -60,12 +58,18 @@ driveFlag :: String
 driveFlag = "org.freedesktop.UDisks2.Drive"
 addedHasDrive :: [Variant] -> Bool
-addedHasDrive [_, a] = maybe False (member driveFlag)
+addedHasDrive [_, a] =
  maybe
    False
    (member driveFlag)
    (fromVariant a :: Maybe (Map String (Map String Variant)))
 addedHasDrive _ = False
 removedHasDrive :: [Variant] -> Bool
-removedHasDrive [_, a] = maybe False (driveFlag `elem`)
+removedHasDrive [_, a] =
  maybe
    False
    (driveFlag `elem`)
    (fromVariant a :: Maybe [String])
 removedHasDrive _ = False
@ -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           Data.Internal.Dependency
 import           RIO
 import DBus
 import DBus.Client
 import qualified DBus.Introspection as I
-
+import Data.Internal.DBus
 import Data.Internal.Dependency
 import Graphics.X11.XScreenSaver
 import Graphics.X11.Xlib.Display
-
+import RIO
 import XMonad.Internal.DBus.Common
 import XMonad.Internal.Shell
 --------------------------------------------------------------------------------
-- | Low-level functions
+-- Low-level functions
 type SSState = Bool -- true is enabled
@ -50,13 +47,13 @@ query = do
  xssi <- xScreenSaverQueryInfo dpy
  closeDisplay dpy
  return $ case xssi of
-    Just XScreenSaverInfo { xssi_state = ScreenSaverDisabled } -> False
+    Just XScreenSaverInfo {xssi_state = ScreenSaverDisabled} -> False
-    Just XScreenSaverInfo { xssi_state = _ }                   -> True
+    Just XScreenSaverInfo {xssi_state = _} -> True
    -- TODO handle errors better (at least log them?)
    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,28 +78,34 @@ sigCurrentState :: Signal
 sigCurrentState = signal ssPath interface memState
 ruleCurrentState :: MatchRule
-ruleCurrentState = matchAny
+ruleCurrentState =
  matchAny
    { matchPath = Just ssPath
    , matchInterface = Just interface
    , matchMember = Just memState
    }
 emitState :: Client -> SSState -> IO ()
-emitState client sss = emit client $ sigCurrentState { signalBody = [toVariant sss] }
+emitState client sss = emit client $ sigCurrentState {signalBody = [toVariant sss]}
 bodyGetCurrentState :: [Variant] -> Maybe SSState
 bodyGetCurrentState [b] = fromVariant b :: Maybe SSState
 bodyGetCurrentState _ = Nothing
 --------------------------------------------------------------------------------
-- | 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
       in liftIO $
            export
              cl'
              ssPath
              defaultInterface
                { interfaceName = interface
                , interfaceMethods =
                    [ autoMethod memToggle $ emitState cl' =<< toggle
@ -110,11 +113,11 @@ exportScreensaver ses =
                    ]
                , interfaceSignals = [sig]
                }
-    sig = I.Signal
+    sig =
      I.Signal
        { I.signalName = memState
        , I.signalArgs =
-        [
+            [ I.SignalArg
          I.SignalArg
                { I.signalArgName = "enabled"
                , I.signalArgType = TypeBoolean
                }
@ -124,8 +127,15 @@ exportScreensaver ses =
    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.Text (pack, unpack)
 import Data.Text.IO as T (readFile, writeFile)
 import RIO
 import RIO.Directory
 import RIO.FilePath
 import System.IO.Error
 --------------------------------------------------------------------------------
-- | read
+-- read
 readInt :: (Read a, Integral a) => FilePath -> IO a
 readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile
 readBool :: FilePath -> IO Bool
-readBool = fmap (==(1 :: Int)) . readInt
+readBool = fmap (== (1 :: Int)) . readInt
 --------------------------------------------------------------------------------
-- | write
+-- write
 writeInt :: (Show a, Integral a) => FilePath -> a -> IO ()
 writeInt f = T.writeFile f . pack . show
@ -53,16 +52,16 @@ writeBool :: FilePath -> Bool -> IO ()
 writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
 --------------------------------------------------------------------------------
-- | percent-based read/write
+-- percent-based read/write
 --
 -- "Raw" values are whatever is stored in sysfs and "percent" is the user-facing
 -- value. Assume that the file being read has a min of 0 and an unchanging max
 -- given by a runtime argument, which is scaled linearly to the range 0-100
 -- (percent).
 rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => (a, a) -> b -> c
 rawToPercent (lower, upper) raw =
  100 * (fromIntegral raw - fromIntegral lower) / fromIntegral (upper - lower)
 -- rawToPercent upper raw = 100 * fromIntegral raw / fromIntegral upper
 readPercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
@ -71,12 +70,14 @@ readPercent bounds path = do
  return $ rawToPercent bounds (i :: Integer)
 percentToRaw :: (Integral a, RealFrac b, Integral c) => (a, a) -> b -> c
-percentToRaw (lower, upper) perc = round $
+percentToRaw (lower, upper) perc =
  round $
    fromIntegral lower + perc / 100.0 * (fromIntegral upper - fromIntegral lower)
 writePercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> b -> IO b
 writePercent bounds path perc = do
-  let t | perc > 100 = 100
+  let t
        | perc > 100 = 100
        | perc < 0 = 0
        | otherwise = perc
  writeInt path (percentToRaw bounds t :: Int)
@ -88,9 +89,15 @@ writePercentMin bounds path = writePercent bounds path 0
 writePercentMax :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
 writePercentMax bounds path = writePercent bounds path 100
-shiftPercent :: (Integral a, RealFrac b) => (b -> b -> b) -> Int -> FilePath
+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)
--- 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,38 +9,41 @@
 -- 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 RIO
 import qualified RIO.Text as T
 import XMonad.Internal.Shell
 --------------------------------------------------------------------------------
-- | Some nice default notes
+-- Some nice default notes
 defNote :: Note
-defNote = blankNote { summary = "\"xmonad\"" }
+defNote = blankNote {summary = "\"xmonad\""}
 defNoteInfo :: Note
-defNoteInfo = defNote
+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
@ -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 qualified System.Process.Typed as P
 import qualified XMonad.Core as X
 import qualified XMonad.Util.Run as XR
--------------------------------------------------------------------------------
+-- | Fork a new process and wait for its exit code.
-- | Opening subshell
+--
-- https://github.com/xmonad/xmonad/issues/113
+-- This function will work despite xmonad ignoring SIGCHLD.
 --
 -- A few facts about xmonad (and window managers in general):
 -- 1) It is single-threaded (since X is single threaded)
 -- 2) Because of (1), it ignores SIGCHLD, which means any subprocess started
 --    by xmonad will instantly be reaped after spawning. This guarantees the
 --    main thread running the WM will never be blocked.
 --
 -- In general, this means I can't wait for exit codes (since wait() doesn't
 -- work) See https://github.com/xmonad/xmonad/issues/113.
 --
 -- If I want an exit code, The best solution (I can come up with), is to use
 -- bracket to uninstall handlers, run process (with wait), and then reinstall
 -- handlers. I can use this with a much higher-level interface which will make
 -- things easier. This obviously means that if the process is running in the
 -- main thread, it needs to be almost instantaneous. Note if using a high-level
 -- API for this, the process needs to spawn, finish, and be reaped by the
 -- xmonad process all while the signal handlers are 'disabled' (which limits
 -- the functions I can use to those that call waitForProcess).
 --
 -- XMonad and contrib use their own method of spawning subprocesses using the
 -- extremely low-level 'System.Process.Posix' API. See the code for
 -- 'XMonad.Core.spawn' or 'XMonad.Util.Run.safeSpawn'. Specifically, the
 -- sequence is (in terms of the low level Linux API):
 -- 1) call fork()
 -- 2) uninstall signal handlers (to allow wait() to work in subprocesses)
 -- 3) call setsid() (so killing the child will kill its children, if any)
 -- 4) start new thing with exec()
 --
 -- In contrast with high-level APIs like 'System.Process', this will leave no
 -- trailing data structures to clean up, at the cost of being gross to look at
 -- and possibly more error-prone.
 runProcess :: P.ProcessConfig a b c -> IO ExitCode
 runProcess = withDefaultSignalHandlers . P.runProcess
 -- | Run an action without xmonad's signal handlers.
 withDefaultSignalHandlers :: IO a -> IO a
 withDefaultSignalHandlers =
  bracket_ X.uninstallSignalHandlers X.installSignalHandlers
 -- | Set a child process to create a new group and session
 addGroupSession :: P.ProcessConfig x y z -> P.ProcessConfig x y z
 addGroupSession = P.setCreateGroup True . P.setNewSession True
-runProcess :: P.ProcessConfig a b c -> IO ExitCode
+-- | 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 qualified XMonad.Layout.Decoration as D
 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,14 +92,16 @@ sRGB24showT :: (RealFrac a, Floating a) => Colour a -> T.Text
 sRGB24showT = T.pack . sRGB24show
 --------------------------------------------------------------------------------
-- | Fonts
+-- Fonts
-data Slant = Roman
+data Slant
  = Roman
  | Italic
  | Oblique
  deriving (Eq, Show)
-data Weight = Light
+data Weight
  = Light
  | Medium
  | Demibold
  | Bold
@ -119,15 +120,21 @@ type FontBuilder = FontData -> T.Text
 buildFont :: Maybe T.Text -> FontData -> T.Text
 buildFont Nothing _ = "fixed"
-buildFont (Just fam) FontData { weight = w
+buildFont
  (Just fam)
  FontData
    { weight = w
    , slant = l
    , size = s
    , pixelsize = p
    , antialias = a
-                            }
+    } =
-  = T.intercalate ":" $ ["xft", fam] ++ elems
+    T.intercalate ":" $ ["xft", fam] ++ elems
    where
-    elems = [ T.concat [k, "=", v] | (k, Just v) <- [ ("weight", showLower w)
+      elems =
        [ T.concat [k, "=", v]
        | (k, Just v) <-
            [ ("weight", showLower w)
            , ("slant", showLower l)
            , ("size", showLower s)
            , ("pixelsize", showLower p)
@ -141,10 +148,11 @@ fallbackFont :: FontBuilder
 fallbackFont = buildFont Nothing
 --------------------------------------------------------------------------------
-- | Default font and data
+-- Default font and data
 defFontData :: FontData
-defFontData = FontData
+defFontData =
  FontData
    { size = Just 10
    , antialias = Just True
    , weight = Nothing
@ -162,37 +170,35 @@ 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
  -- this is in a newer version
      -- , D.activeBorderWidth     = 0
      -- , D.inactiveBorderWidth   = 0
      -- , D.urgentBorderWidth     = 0
-  , D.decoHeight            = 20
+      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.font = T.unpack $ fb $ defFontData {size = Just 12}
    , P.bgColor = T.unpack bgColor
    , P.fgColor = T.unpack fgColor
    , P.fgHLight = T.unpack selectedFgColor
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@ -1,21 +1,22 @@
 {-# 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 qualified RIO.Text as T
 import Xmobar.Plugins.Common
-startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ())
+startBacklight
-  -> (SesClient -> IO (Maybe a)) -> T.Text -> Callback -> IO ()
+  :: RealFrac a
  => ((Maybe a -> IO ()) -> SesClient -> IO ())
  -> (SesClient -> IO (Maybe a))
  -> T.Text
  -> Callback
  -> IO ()
 startBacklight matchSignal callGetBrightness icon cb = do
  withDBusClientConnection cb $ \c -> do
    matchSignal display c
--- 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,26 +33,23 @@
 -- adapter changing.
 module Xmobar.Plugins.Bluetooth
-  ( Bluetooth(..)
+  ( Bluetooth (..)
  , btAlias
  , btDep
-  ) where
+  )
 where
 import Control.Concurrent.MVar
 import Control.Monad
-
+import DBus
 import DBus.Client
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import Data.List
 import Data.List.Split
 import qualified Data.Map as M
 import Data.Maybe
 import           DBus
 import           DBus.Client
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Common
 import Xmobar
 import Xmobar.Plugins.Common
@ -61,8 +58,9 @@ 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
@ -133,7 +131,8 @@ data BtState = BtState
 type MutableBtState = MVar BtState
 emptyState :: BtState
-emptyState = BtState
+emptyState =
  BtState
    { btDevices = M.empty
    , btPowered = Nothing
    }
@ -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
@ -159,7 +158,7 @@ adaptorHasDevice adaptor device = case splitPath device of
  _ -> 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 $
      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           Xmobar
 import           Xmobar.Plugins.BacklightCommon
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import Xmobar
 import Xmobar.Plugins.BacklightCommon
 newtype ClevoKeyboard = ClevoKeyboard T.Text deriving (Read, Show)
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@ -8,22 +8,18 @@ module Xmobar.Plugins.Common
  , fromSingletonVariant
  , withDBusClientConnection
  , Callback
-  , Colors(..)
+  , Colors (..)
  , displayMaybe
  , displayMaybe'
  , xmobarFGColor
  )
-  where
+where
 import Control.Monad
 import           Data.Internal.DBus
 import DBus
 import DBus.Client
-
+import Data.Internal.DBus
 import qualified RIO.Text as T
 import XMonad.Hooks.DynamicLog (xmobarColor)
 -- use string here since all the callbacks in xmobar use strings :(
@ -35,9 +31,15 @@ data Colors = Colors
  }
  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,26 +1,23 @@
 {-# 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 DBus
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import Data.Word
 import           DBus
 import qualified RIO.Text as T
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
 import Xmobar
@ -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 =
      (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           Xmobar
 import           Xmobar.Plugins.BacklightCommon
 import XMonad.Internal.DBus.Brightness.IntelBacklight
 import Xmobar
 import Xmobar.Plugins.BacklightCommon
 newtype IntelBacklight = IntelBacklight T.Text deriving (Read, Show)
--- a/lib/Xmobar/Plugins/Screensaver.hs
+++ b/lib/Xmobar/Plugins/Screensaver.hs
@ -1,21 +1,20 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | Screensaver plugin
+-- Screensaver plugin
 --
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 module Xmobar.Plugins.Screensaver
-  ( Screensaver(..)
+  ( Screensaver (..)
  , ssAlias
-  ) where
+  )
 where
 import qualified RIO.Text as T
 import           Xmobar
 import XMonad.Internal.DBus.Screensaver
 import Xmobar
 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,31 +1,28 @@
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
-- | VPN plugin
+-- VPN plugin
 --
 -- Use the networkmanager to detect when a VPN interface is added or removed.
 -- Specifically, monitor the object tree to detect paths with the interface
 -- "org.freedesktop.NetworkManager.Device.Tun".
 module Xmobar.Plugins.VPN
-  ( VPN(..)
+  ( VPN (..)
  , vpnAlias
  , vpnDep
-  ) where
+  )
 where
 import Control.Concurrent.MVar
 import Control.Monad
-
+import DBus
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import qualified Data.Map as M
 import Data.Maybe
 import qualified Data.Set as S
 import           DBus
 import qualified RIO.Text as T
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
 import Xmobar
@ -47,7 +44,7 @@ instance Exec VPN 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
@ -100,16 +99,21 @@ removedCallback state display [device, interfaces] = update >> display
    update = updateDevice S.delete state device is
 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