add swapLeft and swapRight

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:

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 ()

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
 

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)