From abbd6294c6640ec140c5f056ddb216f704777e83 Mon Sep 17 00:00:00 2001
From: bobstopper <bobstopper@bobturf.org>
Date: Tue, 22 May 2007 07:00:08 +0200
Subject: add swapLeft and swapRight
darcs-hash:20070522050008-ee4f8-6073519fac239b25e5e265ce3995ee75683fcb81.gz
---
Config.hs | 5 +++-
Operations.hs | 10 ++++----
StackSet.hs | 31 ++++++++++++++++++------
tests/Properties.hs | 69 +++++++++++++++++++++++++++++++++++------------------
4 files changed, 80 insertions(+), 35 deletions(-)
diff --git a/Config.hs b/Config.hs
index b199cb2..1e6f3d4 100644
--- a/Config.hs
+++ b/Config.hs
@@ -160,6 +160,9 @@ keys = M.fromList $
, ((modMask, xK_j ), focusRight)
, ((modMask, xK_k ), focusLeft)
+ , ((modMask, xK_Left ), swapLeft)
+ , ((modMask, xK_Right ), swapRight)
+
, ((modMask, xK_h ), sendMessage Shrink)
, ((modMask, xK_l ), sendMessage Expand)
@@ -172,7 +175,7 @@ keys = M.fromList $
, ((modMask .|. shiftMask .|. controlMask, xK_q ), restart Nothing False)
-- Cycle the current tiling order
- , ((modMask, xK_Return), swap)
+ , ((modMask, xK_Return), swapMaster)
] ++
-- Keybindings to get to each workspace:
diff --git a/Operations.hs b/Operations.hs
index 2b35895..39a5a35 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -51,13 +51,15 @@ unmanage :: Window -> X ()
unmanage = windows . W.delete
-- | focus. focus window to the left or right.
-focusLeft, focusRight :: X ()
+focusLeft, focusRight, swapLeft, swapRight :: X ()
focusLeft = windows W.focusLeft
focusRight = windows W.focusRight
+swapLeft = windows W.swapLeft
+swapRight = windows W.swapRight
--- | swap. Move the currently focused window into the master frame
-swap :: X ()
-swap = windows W.swap
+-- | swapMaster. Move the currently focused window into the master frame
+swapMaster :: X ()
+swapMaster = windows W.swapMaster
-- | shift. Move a window to a new workspace, 0 indexed.
shift :: WorkspaceId -> X ()
diff --git a/StackSet.hs b/StackSet.hs
index c591d14..fe9d20c 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -77,8 +77,8 @@
module StackSet (
StackSet(..), Workspace(..), Screen(..), Stack(..),
new, view, lookupWorkspace, peek, index, focusLeft, focusRight,
- focusWindow, member, findIndex, insertLeft, delete, swap, shift,
- modify -- needed by users
+ focusWindow, member, findIndex, insertLeft, delete, shift,
+ swapMaster, swapLeft, swapRight, modify -- needed by users
) where
import Data.Maybe (listToMaybe)
@@ -92,10 +92,11 @@ import qualified Data.List as L (delete,find,genericSplitAt)
-- index,
-- peek, -- was: peek/peekStack
-- focusLeft, focusRight, -- was: rotate
+-- swapLeft, swapRight
-- focus -- was: raiseFocus
-- insertLeft, -- was: insert/push
-- delete,
--- swap, -- was: promote
+-- swapMaster, -- was: promote/swap
-- member,
-- shift,
-- lookupWorkspace, -- was: workspace
@@ -239,12 +240,18 @@ index = with [] $ \(Node t l r) -> reverse l ++ t : r
-- let is = t : r ++ reverse l in take (length is) (dropWhile (/= m) (cycle is))
--
--- /O(1), O(w) on the wrapping case/. Move the window focus left or
+-- /O(1), O(w) on the wrapping case/.
+--
+-- focusLeft, focusRight. Move the window focus left or
-- right, wrapping if we reach the end. The wrapping should model a
-- 'cycle' on the current stack. The 'master' window, and window order,
-- are unaffected by movement of focus.
--
-focusLeft, focusRight :: StackSet i a s -> StackSet i a s
+-- swapLeft, swapRight. Swap the focused window with its left or right
+-- neighbour in the stack ordering, wrapping if we reach the end. Again
+-- the wrapping model should 'cycle' on the current stack.
+--
+focusLeft, focusRight, swapLeft, swapRight :: StackSet i a s -> StackSet i a s
focusLeft = modify Empty $ \c -> case c of
Node _ [] [] -> c
Node t (l:ls) rs -> Node l ls (t:rs)
@@ -255,6 +262,16 @@ focusRight = modify Empty $ \c -> case c of
Node t ls (r:rs) -> Node r (t:ls) rs
Node t ls [] -> Node x [] (xs ++ [t]) where (x:xs) = reverse ls
+swapLeft = modify Empty $ \c -> case c of
+ Node _ [] [] -> c
+ Node t (l:ls) rs -> Node t ls (l:rs)
+ Node t [] rs -> Node t (reverse rs) []
+
+swapRight = modify Empty $ \c -> case c of
+ Node _ [] [] -> c
+ Node t ls (r:rs) -> Node t (r:ls) rs
+ Node t ls [] -> Node t [] (reverse ls)
+
--
-- | /O(1) on current window, O(n) in general/. Focus the window 'w',
-- and set its workspace as current.
@@ -342,8 +359,8 @@ delete w s | Just w == peek s = remove s -- common case.
-- /O(s)/. Set the master window to the focused window.
-- The old master window is swapped in the tiling order with the focused window.
-- Focus stays with the item moved.
-swap :: StackSet i a s -> StackSet i a s
-swap = modify Empty $ \c -> case c of
+swapMaster :: StackSet i a s -> StackSet i a s
+swapMaster = modify Empty $ \c -> case c of
Node _ [] _ -> c -- already master.
Node t ls rs -> Node t [] (ys ++ x : rs) where (x:ys) = reverse ls
diff --git a/tests/Properties.hs b/tests/Properties.hs
index 7e10fe0..eb40539 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -155,7 +155,12 @@ prop_delete_I (x :: T) = invariant $
Nothing -> x
Just i -> delete i x
-prop_swap_I (x :: T) = invariant $ swap x
+prop_swap_master_I (x :: T) = invariant $ swapMaster x
+
+prop_swap_left_I (n :: NonNegative Int) (x :: T) =
+ invariant $ foldr (const swapLeft ) x [1..n]
+prop_swap_right_I (n :: NonNegative Int) (x :: T) =
+ invariant $ foldr (const swapRight) x [1..n]
prop_shift_I (n :: NonNegative Int) (x :: T) =
fromIntegral n < size x ==> invariant $ shift (fromIntegral n) x
@@ -349,8 +354,8 @@ prop_insert_peek (n :: Positive Int) (m :: Positive Int) (NonEmptyNubList is) =
--
prop_insert_delete n x = not (member n x) ==> delete n (insertLeft n y) == (y :: T)
where
- y = swap x -- sets the master window to the current focus.
- -- otherwise, we don't have a rule for where master goes.
+ y = swapMaster x -- sets the master window to the current focus.
+ -- otherwise, we don't have a rule for where master goes.
-- inserting n elements increases current stack size by n
prop_size_insert is (n :: Positive Int) (m :: Positive Int) =
@@ -379,7 +384,7 @@ prop_delete_insert (x :: T) =
Nothing -> True
Just n -> insertLeft n (delete n y) == y
where
- y = swap x
+ y = swapMaster x
-- delete should be local
prop_delete_local (x :: T) =
@@ -388,20 +393,11 @@ prop_delete_local (x :: T) =
Just i -> hidden_spaces x == hidden_spaces (delete i x)
-- ---------------------------------------------------------------------
--- swap: setting the master window
-
--- prop_swap_reversible a b xs = swap a b (swap a b ys) == ys
--- where ys = nub xs :: [Int]
-
--- swap doesn't change focus
-prop_swap_focus (x :: T)
- = case peek x of
- Nothing -> True
- Just f -> focus (stack (workspace $ current (swap x))) == f
-
--- swap is local
-prop_swap_local (x :: T) = hidden_spaces x == hidden_spaces (swap x)
+-- swapLeft, swapRight, swapMaster: reordiring windows
+-- swap is trivially reversible
+prop_swap_left (x :: T) = (swapLeft (swapRight x)) == x
+prop_swap_right (x :: T) = (swapRight (swapLeft x)) == x
-- TODO swap is reversible
-- swap is reversible, but involves moving focus back the window with
-- master on it. easy to do with a mouse...
@@ -414,7 +410,26 @@ prop_promote_reversible x b = (not . null . fromMaybe [] . flip index x . curren
(Just (z:_)) = flip index x . current $ x
-}
-prop_swap_idempotent (x :: T) = swap (swap x) == swap x
+-- swap doesn't change focus
+prop_swap_master_focus (x :: T) = peek x == (peek $ swapMaster x)
+-- = case peek x of
+-- Nothing -> True
+-- Just f -> focus (stack (workspace $ current (swap x))) == f
+prop_swap_left_focus (x :: T) = peek x == (peek $ swapLeft x)
+prop_swap_right_focus (x :: T) = peek x == (peek $ swapRight x)
+
+-- swap is local
+prop_swap_master_local (x :: T) = hidden_spaces x == hidden_spaces (swapMaster x)
+prop_swap_left_local (x :: T) = hidden_spaces x == hidden_spaces (swapLeft x)
+prop_swap_right_local (x :: T) = hidden_spaces x == hidden_spaces (swapRight x)
+
+-- rotation through the height of a stack gets us back to the start
+prop_swap_all_l (x :: T) = (foldr (const swapLeft) x [1..n]) == x
+ where n = length (index x)
+prop_swap_all_r (x :: T) = (foldr (const swapRight) x [1..n]) == x
+ where n = length (index x)
+
+prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x
-- ---------------------------------------------------------------------
-- shift
@@ -429,7 +444,7 @@ prop_shift_reversible (r :: Int) (x :: T) =
Nothing -> True
Just _ -> normal ((view n . shift n . view i . shift i) y) == normal y
where
- y = swap x
+ y = swapMaster x
------------------------------------------------------------------------
-- some properties for layouts:
@@ -523,10 +538,18 @@ main = do
,("delete is reversible", mytest prop_delete_insert)
,("delete is local" , mytest prop_delete_local)
- ,("swap: invariant " , mytest prop_swap_I)
- ,("swap id on focus" , mytest prop_swap_focus)
- ,("swap is idempotent" , mytest prop_swap_idempotent)
- ,("swap is local" , mytest prop_swap_local)
+ ,("swapMaster: invariant", mytest prop_swap_master_I)
+ ,("swapLeft: invariant" , mytest prop_swap_left_I)
+ ,("swapRight: invariant", mytest prop_swap_right_I)
+ ,("swapMaster id on focus", mytest prop_swap_master_focus)
+ ,("swapLeft id on focus", mytest prop_swap_left_focus)
+ ,("swapRight id on focus", mytest prop_swap_right_focus)
+ ,("swapMaster is idempotent", mytest prop_swap_master_idempotent)
+ ,("swap all left " , mytest prop_swap_all_l)
+ ,("swap all right " , mytest prop_swap_all_r)
+ ,("swapMaster is local" , mytest prop_swap_master_local)
+ ,("swapLeft is local" , mytest prop_swap_left_local)
+ ,("swapRight is local" , mytest prop_swap_right_local)
,("shift: invariant" , mytest prop_shift_I)
,("shift is reversible" , mytest prop_shift_reversible)
--
cgit v1.2.3