run ormolu

3 files changed, 188 insertions, 155 deletions

diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index 993726b..47156bb 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -19,20 +19,20 @@ module Rahm.Desktop.Common
   )
 where
 
-import Rahm.Desktop.Logger
-import Data.Void (absurd, Void (..))
-import Data.Either (either)
 import Control.Applicative ((<*))
 import Control.Monad (forM_, void, when)
-import Control.Monad.Trans.Maybe (MaybeT (..))
-import Control.Monad.Trans.Identity (IdentityT (..))
-import Control.Monad.Trans.Except (runExceptT, ExceptT (..), catchE, throwE)
 import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except (ExceptT (..), catchE, runExceptT, throwE)
+import Control.Monad.Trans.Identity (IdentityT (..))
+import Control.Monad.Trans.Maybe (MaybeT (..))
 import Data.Char (toLower)
+import Data.Either (either)
 import Data.List (concatMap, head, isInfixOf, map, (++))
 import qualified Data.Map as Map (fromListWith)
 import Data.Maybe (Maybe (..), maybe)
+import Data.Void (Void (..), absurd)
 import Rahm.Desktop.DMenu (runDMenuPromptWithMap)
+import Rahm.Desktop.Logger
 import qualified Rahm.Desktop.StackSet as S
   ( Screen (Screen, workspace),
     StackSet (StackSet, current),
@@ -127,24 +127,26 @@ windowJump = mapM_ (focus . head) =<< askWindowId
 
 -- Have to add a definition because Stack uses an ancient version of
 -- transformers for some reason.
-myFinallyE :: Monad m => ExceptT e m a -> ExceptT e m () -> ExceptT e m a
+myFinallyE :: (Monad m) => ExceptT e m a -> ExceptT e m () -> ExceptT e m a
 myFinallyE m closer = catchE (m <* closer) (\e -> closer >> throwE e)
 
 -- Temporarily set the border color of the given windows.
 withBorderColorE :: String -> [Window] -> ExceptT e X a -> ExceptT e X a
 withBorderColorE color wins fn = do
   d <- lift $ asks display
-  (px, oPx, fPx) <- lift $
-     (,,)
-       <$> stringToPixel d color
-       <*> (stringToPixel d =<< asks (normalBorderColor . config))
-       <*> (stringToPixel d =<< asks (focusedBorderColor . config))
-
-  (colorName, oColorName, fColorName) <- lift $
-    (,,)
-       <$> io (pixelToString d px)
-       <*> io (pixelToString d oPx)
-       <*> io (pixelToString d fPx)
+  (px, oPx, fPx) <-
+    lift $
+      (,,)
+        <$> stringToPixel d color
+        <*> (stringToPixel d =<< asks (normalBorderColor . config))
+        <*> (stringToPixel d =<< asks (focusedBorderColor . config))
+
+  (colorName, oColorName, fColorName) <-
+    lift $
+      (,,)
+        <$> io (pixelToString d px)
+        <*> io (pixelToString d oPx)
+        <*> io (pixelToString d fPx)
 
   forM_ wins $ \w ->
     lift $ setWindowBorderWithFallback d w colorName px
@@ -164,7 +166,7 @@ withBorderColorM s ws fn = toMaybeT $ withBorderColorE s ws (toExceptT fn)
 
 withBorderColor :: String -> [Window] -> X a -> X a
 withBorderColor s ws fn =
-   either absurd id <$> runExceptT (withBorderColorE s ws (lift fn))
+  either absurd id <$> runExceptT (withBorderColorE s ws (lift fn))
 
 withBorderWidth :: Int -> [Window] -> X a -> X a
 withBorderWidth width ws fn = do
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index bc80aa9..d61dbd6 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -39,7 +39,8 @@ import Graphics.X11.ExtraTypes.XF86
     xF86XK_MonBrightnessUp,
   )
 import Rahm.Desktop.Common
-  ( focusLocation,
+  ( Location (..),
+    focusLocation,
     getCurrentWorkspace,
     gotoWorkspace,
     locationWindow,
@@ -47,7 +48,6 @@ import Rahm.Desktop.Common
     runMaybeT_,
     withBorderColor,
     withBorderColorM,
-    Location(..),
   )
 import Rahm.Desktop.DMenu (runDMenu)
 import Rahm.Desktop.History
@@ -377,12 +377,14 @@ keymap = runKeys $ do
   bind xK_bracketright $ do
     justMod $
       doc "Increase the gaps between windows." $
-        sendMessage $ modifyWindowBorder 5
+        sendMessage $
+          modifyWindowBorder 5
 
   bind xK_bracketleft $ do
     justMod $
       doc "Decrease the gaps between windows." $
-        sendMessage $ modifyWindowBorder (-5)
+        sendMessage $
+          modifyWindowBorder (-5)
 
   bind xK_b $ do
     justMod $ spawnX "bluetooth-select.sh"
@@ -403,8 +405,8 @@ keymap = runKeys $ do
         sendMessage flipHorizontally
 
   bind xK_g $ do
-    justMod $
-      doc
+    justMod
+      $ doc
         "Goto To a workspace\n\n\t\
         \Workspacs are alphanumeric characters. So if the next key typed is an\n\t\
         \alphanumeric character, that's the workspace to operate on\n\n\
@@ -423,11 +425,12 @@ keymap = runKeys $ do
         \_: Black hole. Sending a window here closes it.\n\n\t\
         \Other keybindings starting with H-g\n\t\t\
         \F1: display this help.\n\n\t"
-        $ pushPendingBuffer "g " $
-          runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
+      $ pushPendingBuffer "g "
+      $ runMaybeT_
+      $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
 
-    shiftMod $
-      doc
+    shiftMod
+      $ doc
         "Switch to a different theater.\n\n\t\
         \Theaters are like super-workspaces. They are used for different\n\t\
         \'contexts'. Theaters share all the windows with eachother, but\n\t\
@@ -435,46 +438,47 @@ keymap = runKeys $ do
         \one theater can have window 'x' on workspace 'y', but another might\n\t\
         \have 'x' on 'z' instead. If a theater does explicity place a window,\n\t\
         \the window is placed in the hidden workspace (which is '*')\n"
-        $ pushPendingBuffer "G " $
-          runMaybeT_ $ do
-            mapNextString $ \_ str -> lift $
-              case str of
-                [ch] | isAlpha ch -> restoreTheater (Just [ch])
-                [' '] -> restoreTheater Nothing
-                _ -> return ()
+      $ pushPendingBuffer "G "
+      $ runMaybeT_
+      $ do
+        mapNextString $ \_ str -> lift $
+          case str of
+            [ch] | isAlpha ch -> restoreTheater (Just [ch])
+            [' '] -> restoreTheater Nothing
+            _ -> return ()
 
   bind xK_d $
     justMod $
       doc "Record (define) macros." $
         subkeys $ do
-          bind xK_w $
-            noMod $
-              doc
-                "Record a windowset macro.\n\n\t\
-                \To record a 'windowset' macro, type <M-d>w<key> and then\n\t\
-                \type a character sequence followed by Enter. Now <key> can\n\t\
-                \be used anywhere a 'windowset' is required and that macro\n\t\
-                \will be used.\n\n\t\
-                \For example, if one wants to define '+' as 'all windows \n\t\
-                \not on the current workspace, one can type:\n\n\t\
-                \<M-d>w+\\%@.<Enter>\n"
-                $ pushPendingBuffer "Win Macro " $
-                  runMaybeT_ readWindowsetMacro
-
-          bind xK_t $
-            noMod $
-              doc
-                "Record a workspace macro\n\n\t\
-                \To record a 'workspace' macro, type <M-d>t<key> and then\n\t\
-                \type a character sequence followed by Enter. Now <key> can\n\t\
-                \be used anywhere a 'workspace' is required and that macro\n\t\
-                \will be used.\n\n\t\
-                \For example, if one wants to define '<c-s>' as 'the workspace with\n\t\
-                \the window 's' on it or the last workspace if already on that \n\t\
-                \workspace (more useful that one would think):\n\n\t\
-                \<M-d>t<c-s>?&s@.'s<Enter>\n"
-                $ pushPendingBuffer "Wksp Macro " $
-                  runMaybeT_ readWorkspaceMacro
+          bind xK_w
+            $ noMod
+            $ doc
+              "Record a windowset macro.\n\n\t\
+              \To record a 'windowset' macro, type <M-d>w<key> and then\n\t\
+              \type a character sequence followed by Enter. Now <key> can\n\t\
+              \be used anywhere a 'windowset' is required and that macro\n\t\
+              \will be used.\n\n\t\
+              \For example, if one wants to define '+' as 'all windows \n\t\
+              \not on the current workspace, one can type:\n\n\t\
+              \<M-d>w+\\%@.<Enter>\n"
+            $ pushPendingBuffer "Win Macro "
+            $ runMaybeT_ readWindowsetMacro
+
+          bind xK_t
+            $ noMod
+            $ doc
+              "Record a workspace macro\n\n\t\
+              \To record a 'workspace' macro, type <M-d>t<key> and then\n\t\
+              \type a character sequence followed by Enter. Now <key> can\n\t\
+              \be used anywhere a 'workspace' is required and that macro\n\t\
+              \will be used.\n\n\t\
+              \For example, if one wants to define '<c-s>' as 'the workspace with\n\t\
+              \the window 's' on it or the last workspace if already on that \n\t\
+              \workspace (more useful that one would think):\n\n\t\
+              \<M-d>t<c-s>?&s@.'s<Enter>\n"
+            $ pushPendingBuffer "Wksp Macro "
+            $ runMaybeT_ readWorkspaceMacro
 
   bind xK_h $ do
     justMod $
@@ -525,42 +529,44 @@ keymap = runKeys $ do
         spawnX "xsecurelock"
 
   bind xK_minus $ do
-    justMod $
-      doc
+    justMod
+      $ doc
         "Decrease the number of windows in the  master region, or decrease\n\t\
         \the size of the master region if the current layout cannot have more\n\t\
         \than one window in the master region."
-        $ sendMessage $ IncMasterN (-1)
+      $ sendMessage
+      $ IncMasterN (-1)
 
     shiftMod $
       doc "For mosaic layout, shrink the size-share of the current window" $
         sendMessage =<< shrinkPositionAlt
 
   bind xK_m $ do
-    justMod $
-      doc
+    justMod
+      $ doc
         "Mark the windows described by the window set with a given character.\n\n\t\
         \For example, to mark the current window use <M-m>.<character>. That window\n\n\t\
         \can then be recalled anywhere that requires a WML window.\n"
-        $ do
-          pushPendingBuffer "m " $ do
-            locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
-            let wins = mapMaybe locationWindow locs
-            unless (null wins) $ do
-              withBorderColor "#00ffff" wins $ do
-                runMaybeT_ $ do
-                  mapNextString $ \_ str -> lift $
-                    case str of
-                      [ch] | isAlpha ch -> markAllLocations str locs
-                      _ -> return ()
+      $ do
+        pushPendingBuffer "m " $ do
+          locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
+          let wins = mapMaybe locationWindow locs
+          unless (null wins) $ do
+            withBorderColor "#00ffff" wins $ do
+              runMaybeT_ $ do
+                mapNextString $ \_ str -> lift $
+                  case str of
+                    [ch] | isAlpha ch -> markAllLocations str locs
+                    _ -> return ()
 
   bind xK_plus $ do
-    justMod $
-      doc
+    justMod
+      $ doc
         "Increase the number of windows in the  master region, or increase\n\t\
         \the size of the master region if the current layout cannot have more\n\t\
         \than one window in the master region.\n"
-        $ sendMessage $ IncMasterN 1
+      $ sendMessage
+      $ IncMasterN 1
 
     shiftMod $
       doc "For mosaic layout, increase the size-share of the current window." $
@@ -579,34 +585,42 @@ keymap = runKeys $ do
 
   bind xK_s $ do
     forM_ [(False, justMod), (True, shiftMod)] $ \(doView, f) ->
-      f $ doc
+      f
+        $ doc
           ( if doView
               then "Shift a windowset to a workspace and goto that workspace."
               else "Shift a windowset to a workspace"
           )
-          $
-            pushPendingBuffer (if doView then "S " else "s ") $
-                runMaybeT_ $ do
-                  stackset <- lift $ X.windowset <$> X.get
-                  selection <- mapMaybe locationWindow <$> readNextLocationSet
-
-                  withBorderColorM "#00ffff" selection $ do
-                    ws <- readNextWorkspace
-                    (Endo allMovements) <- lift $ mconcat <$> mapM (fmap Endo . moveWindowToWorkspaceFn ws) selection
-                    lift $ do
-                      setAlternateWindows selection
-                      forM_ selection $ \win -> do
-                        mapM_ (\t -> do
-                           logs Debug "Set alternate workspace %s -> %s" (show win) t
-                           setAlternateWorkspace win t) (W.findTag win stackset)
-
-                      windows $ (\ss ->
-                        case () of
-                          () | doView,
-                               (w:_) <- selection,
-                               Just ws <- W.findTag w ss -> W.greedyView ws ss
-                          _ -> ss
-                        ) . allMovements
+        $ pushPendingBuffer (if doView then "S " else "s ")
+        $ runMaybeT_
+        $ do
+          stackset <- lift $ X.windowset <$> X.get
+          selection <- mapMaybe locationWindow <$> readNextLocationSet
+
+          withBorderColorM "#00ffff" selection $ do
+            ws <- readNextWorkspace
+            (Endo allMovements) <- lift $ mconcat <$> mapM (fmap Endo . moveWindowToWorkspaceFn ws) selection
+            lift $ do
+              setAlternateWindows selection
+              forM_ selection $ \win -> do
+                mapM_
+                  ( \t -> do
+                      logs Debug "Set alternate workspace %s -> %s" (show win) t
+                      setAlternateWorkspace win t
+                  )
+                  (W.findTag win stackset)
+
+              windows $
+                ( \ss ->
+                    case () of
+                      ()
+                        | doView,
+                          (w : _) <- selection,
+                          Just ws <- W.findTag w ss ->
+                            W.greedyView ws ss
+                      _ -> ss
+                )
+                  . allMovements
 
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
@@ -663,42 +677,50 @@ keymap = runKeys $ do
                 bind xK_bracketright $ do
                   noMod $
                     doc "Increase the gaps between windows." $
-                      sendMessage $ modifyWindowBorder 5
+                      sendMessage $
+                        modifyWindowBorder 5
 
                 bind xK_bracketleft $ do
                   noMod $
                     doc "Decrease the gaps between windows." $
-                      sendMessage $ modifyWindowBorder (-5)
+                      sendMessage $
+                        modifyWindowBorder (-5)
 
           bind xK_bracketleft $ noMod spaceResize
           bind xK_bracketright $ noMod spaceResize
 
   bind xK_t $ do
     justMod $
-      doc "Spawn a terminal." $ spawnX (terminal config)
+      doc "Spawn a terminal." $
+        spawnX (terminal config)
 
     shiftMod $
-      doc "Sink the current window into the tiling." $ withFocused $ windows . W.sink
+      doc "Sink the current window into the tiling." $
+        withFocused $
+          windows . W.sink
 
     altMod $
-      doc "Spawn a floating terminal" $ spawnX (terminal config ++ " -t Floating\\ Term")
+      doc "Spawn a floating terminal" $
+        spawnX (terminal config ++ " -t Floating\\ Term")
 
-  bind xK_v $
+  bind xK_v
+    $
     -- Allows repeated strokes of M-h and M-l to reduce and increase volume
     -- respectively.
-    justMod $
-      doc
-        "Allows repeated strokes of M-h and M-l to decrease and\n\
-        \increase volume respectively"
-        $ repeatable $ do
-          bind xK_h $
-            justMod decreaseVolumeDoc
+    justMod
+    $ doc
+      "Allows repeated strokes of M-h and M-l to decrease and\n\
+      \increase volume respectively"
+    $ repeatable
+    $ do
+      bind xK_h $
+        justMod decreaseVolumeDoc
 
-          bind xK_l $
-            justMod increaseVolumeDoc
+      bind xK_l $
+        justMod increaseVolumeDoc
 
-          bind xK_v $
-            justMod (return () :: X ())
+      bind xK_v $
+        justMod (return () :: X ())
 
   bind xK_x $ do
     justMod $
@@ -743,8 +765,8 @@ keymap = runKeys $ do
 
           bind xK_m $ do
             (justMod -|- noMod) $
-               doc "Set the media source to control" $
-                 spawnX "media-select.sh"
+              doc "Set the media source to control" $
+                spawnX "media-select.sh"
 
           -- Double-tap Z to toggle zoom.
           bind xK_z $ do
@@ -769,8 +791,8 @@ keymap = runKeys $ do
         sendMessage togglePop
 
   bind xK_F8 $ do
-    justMod $
-      doc
+    justMod
+      $ doc
         "Set the log level.\n\
         \Log levels are, in order\n\n\t\
         \Trace\n\t\
@@ -780,15 +802,15 @@ keymap = runKeys $ do
         \Error\n\t\
         \Fatal\n\n\
         \Log is sent to stdout."
-        $ do
-          ll <- getLogLevel
-          let next = if minBound == ll then maxBound else pred ll
+      $ do
+        ll <- getLogLevel
+        let next = if minBound == ll then maxBound else pred ll
 
-          safeSpawnX
-            "notify-send"
-            ["-t", "2000", printf "LogLevel set to %s" (show next)]
-          setLogLevel next
-          logs next "LogLevel set to %s." (show next)
+        safeSpawnX
+          "notify-send"
+          ["-t", "2000", printf "LogLevel set to %s" (show next)]
+        setLogLevel next
+        logs next "LogLevel set to %s." (show next)
 
   bind xF86XK_Calculator $ do
     noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
@@ -917,17 +939,20 @@ mouseMap = runButtons $ do
           bind button13 $ do
             noMod $
               doc "Kill the window under the cursor" $
-                noWindow $ click >> CopyWindow.kill1
+                noWindow $
+                  click >> CopyWindow.kill1
 
           bind button14 $ do
             noMod $
               doc "Pop the window under the cursor" $
-                noWindow $ click >> sendMessage togglePop
+                noWindow $
+                  click >> sendMessage togglePop
 
           bind button15 $ do
             noMod $
               doc "Spawn 'pavucontrol'" $
-                noWindow $ spawnX "pavucontrol"
+                noWindow $
+                  spawnX "pavucontrol"
 
           let mediaButtons =
                 [ (button4, "Increase volume", noWindow increaseVolume),
@@ -984,7 +1009,8 @@ mouseMap = runButtons $ do
                       bind button13 $
                         noMod $
                           doc "Lock the screen" $
-                            noWindow $ spawnX "xsecurelock"
+                            noWindow $
+                              spawnX "xsecurelock"
                       bind button1 $
                         noMod $
                           doc "Suspend the system" $
@@ -1096,10 +1122,12 @@ windowSpecificBindings config = do
     --   Ctrl+d -> Delete current tab.
 
     bind xK_u $
-      rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_BackSpace)
+      rawMask controlMask $
+        emitKey (controlMask .|. shiftMask, xK_BackSpace)
 
     bind xK_w $
-      rawMask controlMask $ emitKey (controlMask, xK_BackSpace)
+      rawMask controlMask $
+        emitKey (controlMask, xK_BackSpace)
 
     bind xK_b $ do
       rawMask altMask $ emitKey (controlMask, xK_Left)
@@ -1112,17 +1140,20 @@ windowSpecificBindings config = do
         emitKey (controlMask .|. shiftMask, xK_Right)
 
     bind xK_dollar $
-      rawMask altMask $ emitKey (0, xK_End)
+      rawMask altMask $
+        emitKey (0, xK_End)
 
     bind xK_at $ do
       rawMask (altMask .|. shiftMask) $ emitKey (shiftMask, xK_Home)
       rawMask altMask $ emitKey (0, xK_Home)
 
     bind xK_d $
-      rawMask controlMask $ emitKey (controlMask, xK_Tab)
+      rawMask controlMask $
+        emitKey (controlMask, xK_Tab)
 
     bind xK_Escape $
-      rawMask controlMask $ emitKey (controlMask, xK_w)
+      rawMask controlMask $
+        emitKey (controlMask, xK_w)
 
     bind xK_i $ do
       rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_Tab)
@@ -1134,7 +1165,8 @@ windowSpecificBindings config = do
   -- Add a binding to xev as a test.
   configureIf (title =? "Event Tester") $
     bind xK_F2 $
-      noMod $ emitKey (controlMask, xK_F2)
+      noMod $
+        emitKey (controlMask, xK_F2)
   where
     browsers = ["Google-chrome", "Brave-browser", "firefox-default"]
     spotify = ["Spotify"]
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 8abb17b..d1e381c 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -96,9 +96,9 @@ import qualified Rahm.Desktop.StackSet as W
     focusWindow,
     getLocationWorkspace,
     greedyView,
-    shiftWin,
     integrate',
     screens,
+    shiftWin,
     sink,
   )
 import Rahm.Desktop.Submap (mapNextStringWithKeysym)
@@ -131,8 +131,8 @@ import XMonad
     StateExtension (PersistentExtension),
     Typeable,
     Window,
-    WorkspaceId,
     WindowSet,
+    WorkspaceId,
     X,
     asks,
     directories,
@@ -211,8 +211,7 @@ instance ExtensionClass MaybeMacros where
 data Workspace = forall a.
   (Typeable a) =>
   Workspace
-  {
-    moveWindowToWorkspaceFn :: Window -> X (WindowSet -> WindowSet),
+  { moveWindowToWorkspaceFn :: Window -> X (WindowSet -> WindowSet),
     gotoWorkspaceFn :: X (),
     workspaceName :: Maybe String,
     extraWorkspaceData :: a
@@ -285,9 +284,9 @@ alternateWorkspace :: Workspace
 alternateWorkspace =
   Workspace
     { moveWindowToWorkspaceFn = \win -> do
-          alter <- getAlternateWorkspace win
-          return $ \ss -> 
-            maybe ss (\a -> W.shiftWin a win ss) alter,
+        alter <- getAlternateWorkspace win
+        return $ \ss ->
+          maybe ss (\a -> W.shiftWin a win ss) alter,
       gotoWorkspaceFn = do
         (Location _ maybeWin) <- getCurrentLocation
         case maybeWin of
@@ -308,7 +307,7 @@ floatWorkspace ws@Workspace {extraWorkspaceData = d} =
           Just (FloatWorkspace ws') -> do
             movefn <- moveWindowToWorkspaceFn ws' win
             return $ W.sink win . movefn
-          Nothing ->do
+          Nothing -> do
             movefn <- moveWindowToWorkspaceFn ws win
             return $ \ss -> do
               if win `Map.member` W.floating ss
@@ -581,7 +580,7 @@ readNextLocationSet =
       -- Windows in a workspace
       (_, _, s)
         | s == "\t" || s == "@" || s == "\n" ->
-          (mt . windowsInWorkspace) =<< readNextWorkspaceName
+            (mt . windowsInWorkspace) =<< readNextWorkspaceName
       -- The first window in the next window set.
       (_, _, "!") -> (: []) <$> joinMaybe (head <$> readNextLocationSet)
       -- The windows except the first in a window set.