From 0a871fe0c0425d332675a8141ce1da427a572568 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 12 Apr 2022 01:54:43 -0600
Subject: Add another layout modifier to add a hole.

This is mostly an academic exercise, as there's probably not much reason
to put a hole in the layout, but I must admit that sometimes is
aesthetically pleasing to see a little more desktop wallpaper in some
cases.
---
 src/Rahm/Desktop/Layout/Hole.hs | 44 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 44 insertions(+)
 create mode 100644 src/Rahm/Desktop/Layout/Hole.hs

(limited to 'src/Rahm/Desktop/Layout')

diff --git a/src/Rahm/Desktop/Layout/Hole.hs b/src/Rahm/Desktop/Layout/Hole.hs
new file mode 100644
index 0000000..ee59726
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Hole.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE UndecidableInstances, DeriveAnyClass #-}
+
+-- Delegates to a lower layout, but leaves a hole where the next window will go.
+module Rahm.Desktop.Layout.Hole (hole, toggleHole) where
+
+import qualified XMonad.StackSet as W
+import XMonad
+import Data.Maybe (mapMaybe)
+
+import Rahm.Desktop.Windows
+
+data Hole (l :: * -> *) (a :: *) = Hole Bool (l a)
+
+deriving instance Show (l a) => Show (Hole l a)
+deriving instance Read (l a) => Read (Hole l a)
+
+hole :: l a -> Hole l a
+hole = Hole False
+
+toggleHole :: ManageHole
+toggleHole = ManageHole $ \(Hole e l) -> Hole (not e) l
+
+data ManageHole where
+  ManageHole :: (forall l a. Hole l a -> Hole l a) -> ManageHole
+  deriving (Message)
+
+instance (LayoutClass l a, Eq a, Num a) => LayoutClass (Hole l) a where
+  runLayout (W.Workspace t (Hole enabled l) a) rect = do
+    (rects, maybeNewLayout) <- runLayout (app (-1) $ W.Workspace t l a) rect
+    return (filter ((/=(-1)) . fst) rects, fmap (Hole enabled) maybeNewLayout)
+    where
+      app x w | not enabled = w
+      app x (W.Workspace t l s) =
+        case s of
+          Nothing -> 
+            W.Workspace t l (Just $ W.Stack x [] [])
+          Just (W.Stack h c e) ->
+            W.Workspace t l (Just $ W.Stack h c (e ++ [x]))
+  
+  handleMessage h (fromMessage -> Just (ManageHole f)) =
+    return $ Just $ f h
+  handleMessage (Hole e l) a = do
+    maybeNewLayout <- handleMessage l a
+    return (Hole e <$> maybeNewLayout)
-- 
cgit