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.

3 files changed, 53 insertions, 1 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index e780fbf..0ff8da3 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -54,6 +54,7 @@ import Rahm.Desktop.PassMenu
 import Rahm.Desktop.Logger
 import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Swallow
+import Rahm.Desktop.Layout.Hole (toggleHole)
 import Rahm.Desktop.Layout.Pop (PopMessage(..))
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.Layout.Rotate (rotateLayout)
@@ -188,6 +189,12 @@ keymap = runKeys $ do
       doc "Print this documentation." $
       logs (documentation (keymap config))
 
+  bind xK_F8 $
+
+    justMod $
+      doc "Print this documentation." $
+      sendMessage toggleHole
+
   bind xK_F10 $ do
     justMod playPauseDoc
 
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index 6c9ac5a..906a7fc 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -32,11 +32,12 @@ import Rahm.Desktop.Layout.Pop
 import Rahm.Desktop.Layout.Flip
 import Rahm.Desktop.Layout.Rotate
 import Rahm.Desktop.Layout.Redescribe
+import Rahm.Desktop.Layout.Hole
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
-mods = reinterpretResize . poppable . flippable . rotateable
+mods = reinterpretResize . poppable . flippable . rotateable . hole
 
 myLayout =
   fullscreenFull $
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)