Add mapLayout

darcs-hash:20071004234537-a5988-504015d5c938a232d1355c0f3c602cf366c20aea

2 files changed, 15 insertions, 2 deletions

diff --git a/StackSet.hs b/StackSet.hs
index f77edd1..8b8d123 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -25,8 +25,8 @@ module StackSet (
         -- *  Operations on the current stack
         -- $stackOperations
         peek, index, integrate, integrate', differentiate,
-        focusUp, focusDown, focusMaster,
-        focusWindow, tagMember, renameTag, ensureTags, member, findIndex,
+        focusUp, focusDown, focusMaster, focusWindow,
+        tagMember, renameTag, ensureTags, member, findIndex, mapLayout,
         -- * Modifying the stackset
         -- $modifyStackset
         insertUp, delete, delete', filter,
@@ -424,6 +424,12 @@ ensureTags l allt st = et allt (map tag (workspaces st) \\ allt) st
           et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s })
           et (i:is) (r:rs) s = et is rs $ renameTag r i s
 
+mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd
+mapLayout f (StackSet v vs hs m) = StackSet (fScreen v) (map fScreen vs) (map fWorkspace hs) m
+ where
+    fScreen (Screen ws s sd) = Screen (fWorkspace ws) s sd
+    fWorkspace (Workspace t l s) = Workspace t (f l) s
+
 -- | /O(n)/. Is a window in the StackSet.
 member :: Eq a => a -> StackSet i l a s sd -> Bool
 member a s = maybe False (const True) (findIndex a s)
diff --git a/tests/Properties.hs b/tests/Properties.hs
index bd8bc2b..7ef7e67 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -602,6 +602,10 @@ prop_rename1 (x::T) o n = o `tagMember` x && not (n `tagMember` x) ==>
 prop_ensure (x :: T) l xs = let y = ensureTags l xs x
                                 in and [ n `tagMember` y | n <- xs ]
 
+prop_mapLayoutId (x::T) = x == mapLayout id x
+
+prop_mapLayoutInverse (x::T) = x == mapLayout pred (mapLayout succ x)
+
 ------------------------------------------------------------------------
 -- some properties for layouts:
 
@@ -740,6 +744,9 @@ main = do
         ,("renaming works",     mytest prop_rename1)
         ,("ensure works",     mytest prop_ensure)
 
+        ,("mapLayout id", mytest prop_mapLayoutId)
+        ,("mapLayout inverse", mytest prop_mapLayoutInverse)
+
         -- testing for failure:
         ,("abort fails",            mytest prop_abort)
         ,("new fails with abort",   mytest prop_new_abort)