1 files changed, 57 insertions, 65 deletions

diff --git a/src/Rahm/Desktop/Layout/Pop.hs b/src/Rahm/Desktop/Layout/Pop.hs
index 037e664..7e3dbd1 100644
--- a/src/Rahm/Desktop/Layout/Pop.hs
+++ b/src/Rahm/Desktop/Layout/Pop.hs
@@ -8,7 +8,9 @@ module Rahm.Desktop.Layout.Pop (
   Poppable(..),
   PopMessage(..),
   poppable,
-  reinterpretResize) where
+  resizePop,
+  togglePop,
+  setPop) where
 
 import XMonad
 import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
@@ -17,7 +19,7 @@ import qualified XMonad.StackSet as W
 
 import Rahm.Desktop.Layout.ReinterpretMessage
 
-data Poppable a = Poppable {
+data Poppable (l :: * -> *) (a :: *) = Poppable {
     -- True if the current window is popped out or not.
     isPopped :: Bool
 
@@ -26,79 +28,69 @@ data Poppable a = Poppable {
 
     -- Fraction of the screen height around the window.
   , yFrac :: Float
+
+  , wrap :: l  a
   } deriving (Show, Read, Eq, Ord)
 
-instance Default (Poppable a) where
-  def = Poppable {
-      isPopped = False
-    , xFrac = 0.05
-    , 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
-
--- Message to control the state of the popped layouts modifier.
-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
+data PopMessage where
+  PopMessage :: (forall l a. Poppable l a -> Poppable l a) -> PopMessage
+  deriving (Message)
+
+resizePop :: Float -> PopMessage
+resizePop f = PopMessage $ \(Poppable b x y l) -> 
+  Poppable b (g $ x + f) (g $ y + f) l
+  where
+    g = max 0 . min 0.45
+
+setPop :: (Bool -> Bool) -> PopMessage
+setPop f = PopMessage $ \(Poppable b x y l) -> Poppable (f b) x y l
+
+togglePop :: PopMessage
+togglePop = setPop not
+
+poppable :: l a -> Poppable l a
+poppable = Poppable False 0.05 0.05
 
+instance (LayoutClass l a, Eq a) => LayoutClass (Poppable l) a where
+  
   -- If the current layout is not popped, then just return what the underlying
   -- layout returned.
-  redoLayout Poppable { isPopped = False } _ _ returned =
-     return (returned, Nothing)
 
-  -- Can't do anything with an empty stack.
-  redoLayout _ _ Nothing returned = return (returned, Nothing)
-  
-  redoLayout self (Rectangle x y w h) (Just (W.focus -> focused)) returned =
-      return ((focused, newRect) : remaining, Nothing)
+  runLayout (W.Workspace
+              t
+              (Poppable True xs ys l)
+              a@(Just (W.focus -> focused)))
+            rect@(Rectangle x y w h) = do
+    (returned, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+    return
+      ((focused, newRect) : filter ((/=focused) . fst) returned,
+       Poppable True xs ys <$> maybeNewLayout)
     where
-      remaining = filter ((/=focused) . fst) returned
-      wp = floor $ fromIntegral w * xFrac self
-      hp = floor $ fromIntegral h * yFrac self
+      wp = floor $ fromIntegral w * xs
+      hp = floor $ fromIntegral h * ys
       newRect = Rectangle
         (x + wp)
         (y + hp)
         (w - fromIntegral (wp * 2))
         (h - fromIntegral (hp * 2))
 
-  -- Handle the Pop messages associated with this layout.
-  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
-
-  handleMessOrMaybeModifyIt _ _ = return Nothing
+  -- If the pop is not active, just delegate to the underlying layout.
+  runLayout (W.Workspace t (Poppable b x y l) a) rect = do
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+    return (rects, Poppable b x y <$> maybeNewLayout)
+
+  -- If the message is a PopMessage, handle that here.
+  handleMessage p (fromMessage -> Just (PopMessage f)) =
+    return $ Just $ f p
+
+  -- Intercept Shrink/Expand message if the pop is active, and resize the
+  -- pop size.
+  handleMessage p (fromMessage -> Just mess) | isPopped p =
+    case mess of
+      Shrink -> handleMessage p (SomeMessage $ resizePop 0.025)
+      Expand -> handleMessage p (SomeMessage $ resizePop (-0.025))
+
+  -- By default just pass the message to the underlying layout.
+  handleMessage (Poppable b x y l) mess = do
+    maybeNewLayout <- handleMessage l mess
+    return (Poppable b x y <$> maybeNewLayout)