Implement basic screen corners.

It would be really cool to integrate screen corners with the binding
DSL, but that requires extra thought.

3 files changed, 83 insertions, 69 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 0c00be9..4158c6a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,7 +1,7 @@
 import Control.Monad.Reader
   ( MonadReader (ask),
     ReaderT (runReaderT),
-    liftM2,
+    liftM2, MonadIO (liftIO),
   )
 import Data.Char (toUpper)
 import Data.List (isInfixOf, isPrefixOf)
@@ -11,8 +11,6 @@ import Rahm.Desktop.Common
   ( Location (Location),
     getCurrentWorkspace,
   )
-
-import Rahm.Desktop.PopupTerminal
 import Rahm.Desktop.DMenu (menuCommandString)
 import Rahm.Desktop.History (historyHook)
 import Rahm.Desktop.Hooks.WindowChange (withStackChangeHook)
@@ -20,6 +18,7 @@ import Rahm.Desktop.Keys (applyKeys)
 import Rahm.Desktop.Layout (myLayout)
 import Rahm.Desktop.Logger (LogLevel (Debug, Info, Trace), logs)
 import Rahm.Desktop.Marking (Mark, markAllLocations)
+import Rahm.Desktop.PopupTerminal
 import Rahm.Desktop.RebindKeys (WindowHook, remapHook)
 import qualified Rahm.Desktop.StackSet as W
   ( RationalRect (..),
@@ -58,6 +57,7 @@ import XMonad
     doF,
     doFloat,
     doIgnore,
+    doShift,
     floatLocation,
     liftX,
     mod4Mask,
@@ -68,13 +68,14 @@ import XMonad
     title,
     withWindowSet,
     (-->),
-    (=?), doShift,
+    (=?),
   )
 import qualified XMonad as X (xmonad)
 import XMonad.Hooks.DynamicProperty (dynamicTitle)
 import XMonad.Hooks.EwmhDesktops (ewmh)
 import XMonad.Hooks.ManageDocks (docks)
 import XMonad.Hooks.ManageHelpers (doFullFloat, isFullscreen)
+import XMonad.Hooks.ScreenCorners
 import XMonad.Layout.Fullscreen (fullscreenEventHook)
 import XMonad.Util.SpawnOnce (spawnOnce)
 
@@ -91,69 +92,72 @@ main = do
 
   xmobar <- spawnXMobar
 
-  (=<<) X.xmonad $
-    applyKeys $
-      withStackChangeHook
-        ( mconcat
-            [ historyHook,
-              Rahm.Desktop.BorderColors.stackChangeHook
-            ]
-        )
-        $ ewmh $
-          docks $
-            def
-              { terminal = "alacritty",
-                modMask = mod4Mask,
-                borderWidth = 2,
-                keys = const mempty,
-                focusedBorderColor = "#ff6c00",
-                normalBorderColor = "#404040",
-                layoutHook = myLayout,
-                startupHook = do
-                  spawn fp
-                  spawnOnce "alacritty --class popup-terminal",
-                manageHook =
-                  composeAll
-                    [ isFullscreen --> doFullFloat,
-                      doLogWindow,
-                      className =? "Tilda" --> doFloat,
-                      className =? "yakuake" --> doFloat,
-                      className =? "MPlayer" --> doFloat,
-                      className =? "Xfce4-notifyd" --> doIgnore,
-                      className =? "popup-terminal" --> doShift "*" <> updatePopupTerminalHook,
-                      className =? "spotify" --> doShift "s",
-                      className =? "floating-terminal" --> doCenterFloat,
-                      title =? "Event Tester" --> doFloat,
-                      title =? "Notes" --> doCenterFloat,
-                      title =? "xmessage" --> doCenterFloat,
-                      title =? "gxmessage" --> doCenterFloat,
-                      fmap (isInfixOf "wlroots") title --> doCenterFloat,
-                      title =? "Volume Control" --> doCenterFloat,
-                      className =? "mpv" --> doFloat,
-                      className =? "gnubby_ssh_prompt" --> doFloat,
-                      shouldChromeFloat --> doFloat
-                    ],
-                -- This config uses dynamic workspaces, but I have to seed XMonad
-                -- with something. However, this configuration only supports 36
-                -- monitors on boot. If you need more than 15 monitors, you'll have to
-                -- configure those ones after starting XMonad.
-                workspaces =
-                  map return (['w', 'r', 'j', 's', 't'] ++ ['0' .. '9']),
-                handleEventHook =
-                  composeAll
-                    [ traceLogHook,
-                      fullscreenEventHook,
-                      remapHook,
-                      dynamicTitle
-                        ( composeAll
-                            [ title =? "Spotify" --> doMarkWindow "s"
-                            ]
-                        )
-                    ],
-                focusFollowsMouse = False,
-                clickJustFocuses = False,
-                logHook = logHook xmobar
-              }
+  (=<<) X.xmonad
+    $ applyKeys
+    $ withStackChangeHook
+      ( mconcat
+          [ historyHook,
+            Rahm.Desktop.BorderColors.stackChangeHook
+          ]
+      )
+    $ ewmh
+    $ docks
+    $ def
+      { terminal = "alacritty",
+        modMask = mod4Mask,
+        borderWidth = 2,
+        keys = const mempty,
+        focusedBorderColor = "#ff6c00",
+        normalBorderColor = "#404040",
+        layoutHook = myLayout,
+        startupHook = do
+          spawn fp
+          spawnOnce "alacritty --class popup-terminal"
+          addScreenCorner SCUpperLeft (liftIO $ putStrLn "Hello, World!"),
+
+        manageHook =
+          composeAll
+            [ isFullscreen --> doFullFloat,
+              doLogWindow,
+              className =? "Tilda" --> doFloat,
+              className =? "yakuake" --> doFloat,
+              className =? "MPlayer" --> doFloat,
+              className =? "Xfce4-notifyd" --> doIgnore,
+              className =? "popup-terminal" --> doShift "*" <> updatePopupTerminalHook,
+              className =? "spotify" --> doShift "s",
+              className =? "floating-terminal" --> doCenterFloat,
+              title =? "Event Tester" --> doFloat,
+              title =? "Notes" --> doCenterFloat,
+              title =? "xmessage" --> doCenterFloat,
+              title =? "gxmessage" --> doCenterFloat,
+              fmap (isInfixOf "wlroots") title --> doCenterFloat,
+              title =? "Volume Control" --> doCenterFloat,
+              className =? "mpv" --> doFloat,
+              className =? "gnubby_ssh_prompt" --> doFloat,
+              shouldChromeFloat --> doFloat
+            ],
+        -- This config uses dynamic workspaces, but I have to seed XMonad
+        -- with something. However, this configuration only supports 36
+        -- monitors on boot. If you need more than 15 monitors, you'll have to
+        -- configure those ones after starting XMonad.
+        workspaces =
+          map return (['w', 'r', 'j', 's', 't'] ++ ['0' .. '9']),
+        handleEventHook =
+          composeAll
+            [ screenCornerEventHook,
+              traceLogHook,
+              fullscreenEventHook,
+              remapHook,
+              dynamicTitle
+                ( composeAll
+                    [ title =? "Spotify" --> doMarkWindow "s"
+                    ]
+                )
+            ],
+        focusFollowsMouse = False,
+        clickJustFocuses = False,
+        logHook = logHook xmobar
+      }
   where
     traceLogHook e = do
       logs Trace "Event found: %s" (show e)
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index dc6628b..f4efbb3 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -140,6 +140,7 @@ import XMonad.Actions.RotSlaves
     rotAllUp,
   )
 import XMonad.Hooks.ManageDocks (ToggleStruts (..))
+import XMonad.Hooks.ScreenCorners
 import XMonad.Layout.Spacing
   ( Border (..),
     SpacingModifier (..),
@@ -1294,6 +1295,10 @@ bindings = do
         "Kills xmonad. Always binds to the 'Q' key."
         (io exitSuccess :: X ())
 
+cornersConfig :: Map ScreenCorner (X ())
+cornersConfig =
+  Map.fromList [(SCUpperLeft, displayDzenSelection)]
+
 --   where
 --
 --   permuteMods = map (foldl' (.|.) 0) . filterM (const [True, False])
@@ -1326,7 +1331,10 @@ applyKeys c =
                 Map.insert
                   (modMask c .|. shiftMask, xK_q)
                   (spawnX "xmonad --recompile && xmonad --restart")
-                  . keys conf'
+                  . keys conf',
+              startupHook = do
+                startupHook c
+                forM_ (Map.toList cornersConfig) (uncurry addScreenCorner)
             }
 
 windowSpecificBindings ::
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index 12658a9..4d2b4ea 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -10,6 +10,7 @@ import Rahm.Desktop.Layout.ConsistentMosaic
     expandPositionAlt,
     shrinkPositionAlt,
   )
+import Rahm.Desktop.Layout.Explode (explodeable)
 import Rahm.Desktop.Layout.Flip (flippable)
 import Rahm.Desktop.Layout.Hole (hole)
 import Rahm.Desktop.Layout.List
@@ -32,6 +33,7 @@ import XMonad
     fromMessage,
   )
 import XMonad.Hooks.ManageDocks (avoidStruts)
+import XMonad.Hooks.ScreenCorners (screenCornerLayoutHook)
 import XMonad.Layout.Fullscreen (fullscreenFull)
 import XMonad.Layout.LayoutModifier (ModifiedLayout (..))
 import XMonad.Layout.MosaicAlt
@@ -39,9 +41,9 @@ import XMonad.Layout.MosaicAlt
   )
 import XMonad.Layout.Spacing (Border (..), spacingRaw)
 import XMonad.Layout.Spiral (spiral)
-import Rahm.Desktop.Layout.Explode (explodeable)
 
 myLayout =
+  screenCornerLayoutHook $
     fullscreenFull $
       hole $
         pinnable $