Fix bug with Poppable where it was passing the Resize to the underlying layout.

Unfortunately it's a little hacky how this ended up working, but I don't
have a great solution yet.

1 files changed, 41 insertions, 20 deletions

diff --git a/src/Rahm/Desktop/Layout/Pop.hs b/src/Rahm/Desktop/Layout/Pop.hs
index 194e645..037e664 100644
--- a/src/Rahm/Desktop/Layout/Pop.hs
+++ b/src/Rahm/Desktop/Layout/Pop.hs
@@ -4,13 +4,19 @@
 -- frame in the middle of the screen, sort of like fullscreen, but only taking
 -- up a percentage of the screen rather than the whole screen so other windows
 -- are still visible, alebeit typically not usable.
-module Rahm.Desktop.Layout.Pop (Poppable(..), PopMessage(..), poppable) where
+module Rahm.Desktop.Layout.Pop (
+  Poppable(..),
+  PopMessage(..),
+  poppable,
+  reinterpretResize) where
 
 import XMonad
 import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
 import Data.Default (Default(..))
 import qualified XMonad.StackSet as W
 
+import Rahm.Desktop.Layout.ReinterpretMessage
+
 data Poppable a = Poppable {
     -- True if the current window is popped out or not.
     isPopped :: Bool
@@ -29,6 +35,18 @@ instance Default (Poppable a) where
     , yFrac = 0.05
     }
 
+-- Returns a modified layout that converts Resize (Shrink/Expand) into ResizePop
+-- messages. Unfortunately this is required because a LayoutModifier has no way
+-- to intercept messages and block them from propegating, which is pretty silly.
+--
+-- So, reinterpretResize will turn a Shrink/Expand into a ResizePop, this will
+-- be consumed by the Poppable layout modifier. If the Poppable LayoutModifier
+-- is not active, it will turn the ResizePop back into a Shrink/Expand and
+-- forward it to the underlying layout.
+reinterpretResize ::
+  l a -> ModifiedLayout (ReinterpretMessage "ForPop") l a
+reinterpretResize = ModifiedLayout ReinterpretMessage
+
 poppable :: l a -> ModifiedLayout Poppable l a
 poppable = ModifiedLayout def
 
@@ -36,6 +54,15 @@ poppable = ModifiedLayout def
 data PopMessage = TogglePop | Pop | Unpop | ResizePop Float
   deriving (Typeable, Show, Eq, Ord, Message)
 
+instance DoReinterpret "ForPop" where
+  reinterpretMessage _ (fromMessage -> Just mess) =
+    return $ Just $ SomeMessage $
+      case mess of
+        Shrink -> ResizePop (-0.05)
+        Expand -> ResizePop 0.05
+
+  reinterpretMessage _ _ = return Nothing
+
 instance (Eq a) => LayoutModifier Poppable a where
 
   -- If the current layout is not popped, then just return what the underlying
@@ -59,25 +86,19 @@ instance (Eq a) => LayoutModifier Poppable a where
         (h - fromIntegral (hp * 2))
 
   -- Handle the Pop messages associated with this layout.
-  pureMess self (fromMessage -> Just mess) =
-    Just $ case mess of
-      TogglePop -> self { isPopped = not (isPopped self) }
-      Pop -> self { isPopped = True }
-      Unpop -> self { isPopped = False }
-      ResizePop amt -> self {
-          xFrac = guard (xFrac self + amt),
-          yFrac = guard (yFrac self + amt)
-        }
+  handleMessOrMaybeModifyIt self (fromMessage -> Just mess) =
+    return $ Just $ case mess of
+      TogglePop -> Left $ self { isPopped = not (isPopped self) }
+      Pop -> Left $ self { isPopped = True }
+      Unpop -> Left $ self { isPopped = False }
+      ResizePop amt | isPopped self ->
+          Left $ self {
+            xFrac = guard (xFrac self + amt),
+            yFrac = guard (yFrac self + amt)
+          }
+      ResizePop amt -> Right $ SomeMessage $
+        if amt > 0 then Expand else Shrink
     where
       guard = min 0.45 . max 0
 
-  -- Handle Shrink and Expand if it is currently in the popped state.
-  pureMess
-      self@Poppable { isPopped = True }
-      (fromMessage -> Just mess) =
-    pureMess self $ SomeMessage $
-      case mess of
-        Shrink -> ResizePop (-0.05)
-        Expand -> ResizePop 0.05
-
-  pureMess _ _ = Nothing
+  handleMessOrMaybeModifyIt _ _ = return Nothing