update LayoutHelpers to work with new Layout class.

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,
+    LayoutModifier(..)
-    layoutModify,
-    l2lModDo, idModify,
-    idModDo, idModMod,
     ) 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))
+class (Show (m l a), Read (m l a), Layout l a) => LayoutModifier m l a where
-type ModifyLayout a = SomeMessage -> X (Maybe (Layout a))
+    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)
 
-type ModDo a = Rectangle -> Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ModLay a))
+instance LayoutModifier m l a => Layout (m l) a where
-type ModMod a = SomeMessage -> X (Maybe (ModLay a))
+    doLayout m r s = do (ws, ml') <- doLayout (extractLayout m) r s
-
+                        (ws', mmod') <- redoLayout m r s ws
-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'
+                                   Just mod' -> Just $ mod' $ maybe (extractLayout m) id ml'
-                                 Nothing -> layoutModify fdo fmod `fmap` ml'
+                                   Nothing -> wrapLayout m `fmap` ml'
                         return (ws', ml'')
-          modl m = do ml' <- modifyLayout l m
+    modifyLayout m mess = do ml' <- modifyLayout (extractLayout m) mess
-                      mmod' <- fmod m
+                             mmod' <- modifyModify m mess
                              return $ case mmod' of
-                               Just mod' -> Just $ mod' $ maybe l id ml'
+                                      Just  mod' -> Just $ mod' $ maybe (extractLayout m) id ml'
-                               Nothing -> layoutModify fdo fmod `fmap` ml'
+                                      Nothing -> wrapLayout m `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