From 58bea73364833dfe1fe88e5d4928ef41c6304c75 Mon Sep 17 00:00:00 2001
From: David Roundy <droundy@darcs.net>
Date: Sun, 23 Sep 2007 13:49:29 +0200
Subject: update LayoutHelpers to work with new Layout class.

darcs-hash:20070923114929-72aca-0df66e37c244429f62b412bb58b78d06ec4fee6a.gz
---
 LayoutHelpers.hs | 63 ++++++++++++++++++++++----------------------------------
 1 file changed, 25 insertions(+), 38 deletions(-)

(limited to 'LayoutHelpers.hs')

diff --git a/LayoutHelpers.hs b/LayoutHelpers.hs
index 09cd241..e51f45c 100644
--- a/LayoutHelpers.hs
+++ b/LayoutHelpers.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS -fallow-undecidable-instances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonadContrib.LayoutHelpers
@@ -14,49 +15,35 @@
 module XMonadContrib.LayoutHelpers (
     -- * Usage
     -- $usage
-    DoLayout, ModDo, ModMod, ModLay,
-    layoutModify,
-    l2lModDo, idModify,
-    idModDo, idModMod,
+    LayoutModifier(..)
     ) where
 
+import Control.Monad ( mplus )
 import Graphics.X11.Xlib ( Rectangle )
 import XMonad
-import StackSet ( Stack, integrate )
+import StackSet ( Stack )
 
 -- $usage
 -- Use LayoutHelpers to help write easy Layouts.
 
-type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
-type ModifyLayout a = SomeMessage -> X (Maybe (Layout a))
-
-type ModDo a = Rectangle -> Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ModLay a))
-type ModMod a = SomeMessage -> X (Maybe (ModLay a))
-
-type ModLay a = Layout a -> Layout a
-
-layoutModify :: ModDo a -> ModMod a -> ModLay a
-layoutModify fdo fmod l = Layout { doLayout = dl, modifyLayout = modl }
-    where dl r s = do (ws, ml') <- doLayout l r s
-                      (ws', mmod') <- fdo r s ws
-                      let ml'' = case mmod' of
-                                 Just mod' -> Just $ mod' $ maybe l id ml'
-                                 Nothing -> layoutModify fdo fmod `fmap` ml'
-                      return (ws', ml'')
-          modl m = do ml' <- modifyLayout l m
-                      mmod' <- fmod m
-                      return $ case mmod' of
-                               Just mod' -> Just $ mod' $ maybe l id ml'
-                               Nothing -> layoutModify fdo fmod `fmap` ml'
-
-l2lModDo :: (Rectangle -> [a] -> [(a,Rectangle)]) -> DoLayout a
-l2lModDo dl r s = return (dl r $ integrate s, Nothing)
-
-idModDo :: ModDo a
-idModDo _ _ wrs = return (wrs, Nothing)
-
-idModify :: ModifyLayout a
-idModify _ = return Nothing
-
-idModMod :: ModMod a
-idModMod _ = return Nothing
+class (Show (m l a), Read (m l a), Layout l a) => LayoutModifier m l a where
+    extractLayout :: m l a -> l a
+    wrapLayout :: m l a -> l a -> m l a
+    modifyModify :: m l a -> SomeMessage -> X (Maybe (l a ->  m l a))
+    modifyModify _ _ = return Nothing
+    redoLayout :: m l a -> Rectangle -> Stack a -> [(a, Rectangle)]
+               -> X ([(a, Rectangle)], Maybe (l a -> m l a))
+    redoLayout _ _ _ wrs = return (wrs, Nothing)
+
+instance LayoutModifier m l a => Layout (m l) a where
+    doLayout m r s = do (ws, ml') <- doLayout (extractLayout m) r s
+                        (ws', mmod') <- redoLayout m r s ws
+                        let ml'' = case mmod' of
+                                   Just mod' -> Just $ mod' $ maybe (extractLayout m) id ml'
+                                   Nothing -> wrapLayout m `fmap` ml'
+                        return (ws', ml'')
+    modifyLayout m mess = do ml' <- modifyLayout (extractLayout m) mess
+                             mmod' <- modifyModify m mess
+                             return $ case mmod' of
+                                      Just  mod' -> Just $ mod' $ maybe (extractLayout m) id ml'
+                                      Nothing -> wrapLayout m `fmap` ml'
-- 
cgit v1.2.3