From b9eb4934569ce7dc6c320c5ca701b3f16ae2990e Mon Sep 17 00:00:00 2001
From: David Roundy <droundy@darcs.net>
Date: Sun, 23 Sep 2007 21:26:40 +0200
Subject: Update NoBorders and LayoutHelpers.

darcs-hash:20070923192640-72aca-6d42a9003e9339dfd61dab830527c12c880d74f4.gz
---
 LayoutHelpers.hs | 50 +++++++++++++++++++++++++++-----------------------
 NoBorders.hs     | 27 ++++++++++++++-------------
 2 files changed, 41 insertions(+), 36 deletions(-)

diff --git a/LayoutHelpers.hs b/LayoutHelpers.hs
index 4401590..ed7a0f1 100644
--- a/LayoutHelpers.hs
+++ b/LayoutHelpers.hs
@@ -1,4 +1,3 @@
-{-# OPTIONS -fallow-undecidable-instances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonadContrib.LayoutHelpers
@@ -15,37 +14,42 @@
 module XMonadContrib.LayoutHelpers (
     -- * Usage
     -- $usage
-    LayoutModifier(..)
+    LayoutModifier(..), ModifiedLayout(..)
     ) where
 
-import Control.Monad ( mplus )
 import Graphics.X11.Xlib ( Rectangle )
 import XMonad
 import StackSet ( Stack )
+import Operations ( UnDoLayout(UnDoLayout) )
 
 -- $usage
 -- Use LayoutHelpers to help write easy Layouts.
 
-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))
+class (Show (m a), Read (m a)) => LayoutModifier m a where
+    modifyModify :: m a -> SomeMessage -> X (Maybe (m l))
+    modifyModify m mess | Just UnDoLayout <- fromMessage mess = do unhook m; return Nothing
+                        | otherwise = return Nothing
+    redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]
+               -> X ([(a, Rectangle)], Maybe (m l))
     redoLayout m _ _ wrs = do hook m; return (wrs, Nothing)
-    hook :: m l a -> X ()
+    hook :: m a -> X ()
     hook _ = return ()
+    unhook :: m a -> X ()
+    unhook _ = return ()
 
-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'
+instance (LayoutModifier m a, Layout l a) => Layout (ModifiedLayout m l) a where
+    doLayout (ModifiedLayout m l) r s =
+        do (ws, ml') <- doLayout l r s
+           (ws', mm') <- redoLayout m r s ws
+           let ml'' = case mm' of
+                      Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
+                      Nothing -> ModifiedLayout m `fmap` ml'
+           return (ws', ml'')
+    modifyLayout (ModifiedLayout m l) mess =
+        do ml' <- modifyLayout l mess
+           mm' <- modifyModify m mess
+           return $ case mm' of
+                    Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
+                    Nothing -> (ModifiedLayout m) `fmap` ml'
+
+data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )
diff --git a/NoBorders.hs b/NoBorders.hs
index b2476b3..116b569 100644
--- a/NoBorders.hs
+++ b/NoBorders.hs
@@ -18,17 +18,17 @@
 module XMonadContrib.NoBorders (
                                 -- * Usage
                                 -- $usage
-                                noBorders, 
-                                withBorder 
+                                noBorders,
+                                withBorder
                                ) where
 
 import Control.Monad.State ( gets )
 import Graphics.X11.Xlib
 
 import XMonad
-import Operations ( UnDoLayout(UnDoLayout) )
-import qualified StackSet as W
+import XMonadContrib.LayoutHelpers
 import {-# SOURCE #-} Config (borderWidth)
+import qualified StackSet as W
 
 -- $usage
 -- You can use this module with the following in your Config.hs file:
@@ -44,16 +44,17 @@ import {-# SOURCE #-} Config (borderWidth)
 -- %layout -- prepend noBorders to default layouts above to remove their borders, like so:
 -- %layout , noBorders full
 
-noBorders :: Layout a -> Layout a
-noBorders = withBorder 0
+data WithBorder a = WithBorder Dimension deriving ( Read, Show )
+
+instance LayoutModifier WithBorder a where
+    hook (WithBorder b) = setborders b
+    unhook (WithBorder _) = setborders borderWidth
+
+noBorders :: Layout l a => l a -> ModifiedLayout WithBorder l a
+noBorders = ModifiedLayout (WithBorder 0)
 
-withBorder :: Dimension -> Layout a -> Layout a
-withBorder bd l = l { doLayout = \r x -> setborders bd >> doLayout l r x
-                    , modifyLayout = ml }
-    where ml m | Just UnDoLayout == fromMessage m
-                   = do setborders borderWidth
-                        fmap (withBorder bd) `fmap` (modifyLayout l) m
-               | otherwise = fmap (withBorder bd) `fmap` (modifyLayout l) m
+withBorder :: Layout l a => Dimension -> l a -> ModifiedLayout WithBorder l a
+withBorder b = ModifiedLayout (WithBorder b)
 
 setborders :: Dimension -> X ()
 setborders bw = withDisplay $ \d ->
-- 
cgit v1.2.3