diff options
| -rw-r--r-- | Config.hs | 5 | ||||
| -rw-r--r-- | Operations.hs | 10 | ||||
| -rw-r--r-- | StackSet.hs | 31 | ||||
| -rw-r--r-- | tests/Properties.hs | 69 |
4 files changed, 80 insertions, 35 deletions
@@ -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) |