From bc62d80641a5948f41fdfb7d50d8abaae4e0f381 Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@galois.com>
Date: Sat, 13 Oct 2007 22:43:00 +0200
Subject: clean up names of layout code

darcs-hash:20071013204300-cba2c-7f8fb3244bbd918cd28679debad2129db542d7e8.gz
---
 Operations.hs | 51 +++++++++++++++++++++++++++------------------------
 1 file changed, 27 insertions(+), 24 deletions(-)

(limited to 'Operations.hs')

diff --git a/Operations.hs b/Operations.hs
index 223257d..ec2dd04 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -20,7 +20,7 @@ module Operations where
 
 import XMonad
 import qualified StackSet as W
-import {-# SOURCE #-} Config (borderWidth,logHook,manageHook,numlockMask,possibleLayouts)
+import {-# SOURCE #-} Config (borderWidth,logHook,manageHook,numlockMask,serialisedLayouts)
 
 import Data.Maybe
 import Data.List            (nub, (\\), find, partition)
@@ -360,46 +360,49 @@ data ChangeLayout = NextLayout | PrevLayout | JumpToLayout String
 instance Message ChangeLayout
 
 instance ReadableLayout Window where
-    defaults = Layout (LayoutSelection []) :
+    defaults = Layout (Select []) :
                Layout Full : Layout (Tall 1 0.1 0.5) :
                Layout (Mirror $ Tall 1 0.1 0.5) :
-               possibleLayouts
+               serialisedLayouts
 
-data LayoutSelection a = LayoutSelection [Layout a]
-                         deriving ( Show, Read )
+data Select a = Select [Layout a] deriving (Show, Read)
+
+instance ReadableLayout a => LayoutClass Select a where
+    doLayout (Select (l:ls)) r s = do
+        (x,ml') <- doLayout l r s
+        return (x, (\l' -> Select (l':ls)) `fmap` ml')
+
+    doLayout (Select []) r s = do
+        (x,_) <- doLayout Full r s
+        return (x,Nothing)
 
-instance ReadableLayout a => LayoutClass LayoutSelection a where
-    doLayout (LayoutSelection (l:ls)) r s =
-        do (x,ml') <- doLayout l r s
-           return (x, (\l' -> LayoutSelection (l':ls)) `fmap` ml')
-    doLayout (LayoutSelection []) r s = do (x,_) <- doLayout Full r s
-                                           return (x,Nothing)
     -- respond to messages only when there's an actual choice:
-    handleMessage (LayoutSelection (l:ls@(_:_))) m
+    handleMessage (Select (l:ls@(_:_))) m
         | Just NextLayout <- fromMessage m = switchl rls
         | Just PrevLayout <- fromMessage m = switchl rls'
         | Just (JumpToLayout x) <- fromMessage m = switchl (j x)
         | Just ReleaseResources <- fromMessage m =
               do mlls' <- mapM (\ll -> handleMessage ll m) (l:ls)
                  let lls' = zipWith (\x mx -> maybe x id mx) (l:ls) mlls'
-                 return $ Just $ LayoutSelection lls'
+                 return $ Just $ Select lls'
         where rls (x:xs) = xs ++ [x]
               rls [] = []
               rls' = reverse . rls . reverse
-              j s zs = case partition (\z -> s == description z) zs of
-                         (xs,ys) -> xs++ys
+              j s zs = case partition ((s ==) . description) zs of (xs,ys) -> xs++ys
+
               switchl f = do ml' <- handleMessage l (SomeMessage Hide)
-                             return $ Just (LayoutSelection $ f $ fromMaybe l ml':ls)
-    -- otherwise, or if we don't understand the message, pass it along to the real
-    -- layout:
-    handleMessage (LayoutSelection (l:ls)) m
-        =  do ml' <- handleMessage l m
-              return $ (\l' -> LayoutSelection (l':ls)) `fmap` ml'
+                             return $ Just (Select $ f $ fromMaybe l ml':ls)
+
+    -- otherwise, or if we don't understand the message, pass it along to the real layout:
+    handleMessage (Select (l:ls)) m = do
+            ml' <- handleMessage l m
+            return $ (\l' -> Select (l':ls)) `fmap` ml'
+
     -- Unless there is no layout...
-    handleMessage (LayoutSelection []) _ = return Nothing
+    handleMessage (Select []) _ = return Nothing
 
-    description (LayoutSelection (x:_)) = description x
-    description _                       = "default"
+    description (Select (x:_)) = description x
+    description _              = "default"
 --
 -- Builtin layout algorithms:
 --
-- 
cgit v1.2.3