Merge pull request #384 from ivanbrennan/rotate-some

RotateSome

CHANGES.md

@@ -22,6 +22,18 @@
 
 ### New Modules
 
+  * `XMonad.Actions.RotateSome`
+
+    Functions for rotating some elements around the stack while keeping others
+    anchored in place. Useful in combination with layouts that dictate window
+    visibility based on stack position, such as "XMonad.Layout.LimitWindows".
+
+    Export 'surfaceNext' and 'surfacePrev' actions, which treat the focused window
+    and any hidden windows as a ring that can be rotated through the focused position.
+
+    Export 'rotateSome', a pure function that rotates some elements around a stack
+    while keeping others anchored in place.
+
   * `XMonad.Actions.Sift`
 
     Provide 'siftUp' and 'siftDown' actions, which behave like 'swapUp' and 'swapDown'

XMonad/Actions/RotateSome.hs

@@ -0,0 +1,163 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.RotateSome
+-- Copyright   :  (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Ivan Brennan <ivanbrennan@gmail.com>
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- Functions for rotating some elements around the stack while keeping others
+-- anchored in place. Useful in combination with layouts that dictate window
+-- visibility based on stack position, such as "XMonad.Layout.LimitWindows".
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.RotateSome (
+    -- * Usage
+    -- $usage
+    -- * Example
+    -- $example
+    surfaceNext,
+    surfacePrev,
+    rotateSome,
+  ) where
+
+import Control.Arrow ((***))
+import Data.List (partition, sortOn, (\\))
+import qualified Data.Map as M
+import XMonad (Window, WindowSpace, Rectangle, X, runLayout, screenRect, windows, withWindowSet)
+import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modify', stack)
+
+{- $usage
+You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+
+> import XMonad.Actions.RotateSome
+
+and add keybindings such as the following:
+
+>   , ((modMask .|. controlMask, xK_n), surfaceNext)
+>   , ((modMask .|. controlMask, xK_p), surfacePrev)
+
+-}
+
+{- $example
+#Example#
+
+Consider a workspace whose stack contains five windows A B C D E but whose
+layout limits how many will actually be shown, showing only the first plus
+two additional windows, starting with the third:
+
+>  ┌─────┬─────┐
+>  │     │  C  │
+>  │  A  ├─────┤
+>  │     │  D  │
+>  └─────┴─────┘
+>
+>  A  B  C  D  E
+>  _     ____
+
+If C has focus and we'd like to replace it with one of the unshown windows,
+'surfaceNext' will move the next unshown window, E, into the focused position:
+
+>  ┌─────┬─────┐                ┌─────┬─────┐
+>  │     │ *C* │                │     │ *E* │
+>  │  A  ├─────┤ surfaceNext -> │  A  ├─────┤
+>  │     │  D  │                │     │  D  │
+>  └─────┴─────┘                └─────┴─────┘
+>
+>  A  B *C* D  E                A  C *E* D  B
+>  _     ____                   _     ____
+
+This repositioned windows B C E by treating them as a sequence that can be
+rotated through the focused stack position. Windows A and D remain anchored
+to their original (visible) positions.
+
+A second call to 'surfaceNext' moves B into focus:
+
+>  ┌─────┬─────┐                ┌─────┬─────┐
+>  │     │ *E* │                │     │ *B* │
+>  │  A  ├─────┤ surfaceNext -> │  A  ├─────┤
+>  │     │  D  │                │     │  D  │
+>  └─────┴─────┘                └─────┴─────┘
+>
+>  A  C *E* D  B                A  E *B* D  C
+>  _     ____                   _     ____
+
+A third call would complete the cycle, bringing C back into focus.
+
+-}
+
+-- |
+-- Treating the focused window and any unshown windows as a ring that can be
+-- rotated through the focused position, surface the next element in the ring.
+surfaceNext :: X ()
+surfaceNext = do
+  ring <- surfaceRing
+  windows . modify' $ rotateSome (`elem` ring)
+
+-- | Like 'surfaceNext' in reverse.
+surfacePrev :: X ()
+surfacePrev = do
+  ring <- surfaceRing
+  windows . modify' $ reverseStack . rotateSome (`elem` ring) . reverseStack
+
+-- |
+-- Return a list containing the current focus plus any unshown windows. Note
+-- that windows are shown if 'runLayout' provides them with a rectangle or if
+-- they are floating.
+surfaceRing :: X [Window]
+surfaceRing = withWindowSet $ \wset -> do
+  let Screen wsp _ sd = current wset
+
+  case stack wsp >>= filter' (`M.notMember` floating wset) of
+    Nothing -> pure []
+    Just st -> go st <$> layoutWindows wsp {stack = Just st} (screenRect sd)
+  where
+    go :: Stack Window -> [Window] -> [Window]
+    go (Stack t ls rs) shown = t : ((ls ++ rs) \\ shown)
+
+    layoutWindows :: WindowSpace -> Rectangle -> X [Window]
+    layoutWindows wsp rect = map fst . fst <$> runLayout wsp rect
+
+-- | Like "XMonad.StackSet.filter" but won't move focus.
+filter' :: (a -> Bool) -> Stack a -> Maybe (Stack a)
+filter' p (Stack f ls rs)
+  | p f       = Just $ Stack f (filter p ls) (filter p rs)
+  | otherwise = Nothing
+
+-- |
+-- @'rotateSome' p stack@ treats the elements of @stack@ that satisfy predicate
+-- @p@ as a ring that can be rotated, while all other elements remain anchored
+-- in place.
+rotateSome :: (a -> Bool) -> Stack a -> Stack a
+rotateSome p (Stack t ls rs) =
+  let
+    -- Flatten the stack, index each element relative to the focused position,
+    -- then partition into movable and anchored elements.
+    (movables, anchors) =
+      partition (p . snd) $
+        zip
+          [negate (length ls)..]
+          (reverse ls ++ t : rs)
+
+    -- Pair each movable element with the index of its next movable neighbor.
+    -- Append anchored elements, along with their unchanged indices, and sort
+    -- by index. Separate lefts (negative indices) from the rest, and grab the
+    -- new focus from the head of the remaining elements.
+    (ls', t':rs') =
+      (map snd *** map snd)
+        . span ((< 0) . fst)
+        . sortOn fst
+        . (++) anchors
+        . map (fst *** snd)
+        $ zip movables (rotate movables)
+  in
+    Stack t' (reverse ls') rs'
+
+rotate :: [a] -> [a]
+rotate = uncurry (flip (++)) . splitAt 1
+
+reverseStack :: Stack a -> Stack a
+reverseStack (Stack t ls rs) = Stack t rs ls

tests/RotateSome.hs

@@ -0,0 +1,75 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module RotateSome where
+
+import Test.QuickCheck (Arbitrary, Gen, arbitrary, choose, listOf, quickCheck)
+import Utils (applyN)
+import XMonad.StackSet (Stack (Stack), down, focus, integrate, up)
+import XMonad.Actions.RotateSome (rotateSome)
+
+instance Arbitrary (Stack Int) where
+  arbitrary = do
+    foc   <- arbNat
+    ups   <- listOf arbNat
+    downs <- listOf arbNat
+    pure (Stack foc ups downs)
+
+arbNat :: Gen Int
+arbNat = fmap abs arbitrary
+
+newtype Divisor = Divisor Int deriving Show
+instance Arbitrary Divisor where
+  arbitrary = Divisor <$> choose (1, 5)
+
+isMultOf :: Int -> Int -> Bool
+x `isMultOf` n = (x `rem` n) == 0
+
+-- Total number of elements does not change.
+prop_rotate_some_length (Divisor d) (stk :: Stack Int) =
+  length (integrate stk) == length (integrate $ rotateSome (`isMultOf` d) stk)
+
+-- Applying rotateSome N times completes a cycle, where N is the number of
+-- elements that satisfy the predicate.
+prop_rotate_some_cycle (Divisor d) (stk :: Stack Int) =
+  stk == applyN (Just n) (rotateSome (`isMultOf` d)) stk
+  where
+    n = length $ filter (`isMultOf` d) (integrate stk)
+
+-- Elements that do not satisfy the predicate remain anchored in place.
+prop_rotate_some_anchors (Divisor d) (stk :: Stack Int) =
+  all check $
+    zip
+      (integrate stk)
+      (integrate $ rotateSome (`isMultOf` d) stk)
+  where
+    check (before, after) = (before `isMultOf` d) || before == after
+
+-- Elements that satisfy the predicate rotate by one position.
+prop_rotate_some_rotate (Divisor d) (stk :: Stack Int) =
+  drop 1 before ++ take 1 before == after
+  where
+    before = filter p (integrate stk)
+    after = filter p (integrate $ rotateSome p stk)
+    p = (`isMultOf` d)
+
+-- Focus position is preserved.
+prop_rotate_some_focus (Divisor d) (stk :: Stack Int) =
+  length (up stk) == length (up $ rotateSome (`isMultOf` d) stk)
+
+main :: IO ()
+main = do
+  putStrLn "Testing rotateSome length"
+  quickCheck prop_rotate_some_length
+
+  putStrLn "Testing rotateSome cycle"
+  quickCheck prop_rotate_some_cycle
+
+  putStrLn "Testing rotateSome anchors"
+  quickCheck prop_rotate_some_anchors
+
+  putStrLn "Testing rotateSome rotate"
+  quickCheck prop_rotate_some_rotate
+
+  putStrLn "Testing rotateSome focus"
+  quickCheck prop_rotate_some_focus

xmonad-contrib.cabal

@@ -27,6 +27,7 @@ extra-source-files: README.md CHANGES.md scripts/generate-configs scripts/run-xm
                     scripts/xmonad-clock.c
                     tests/genMain.hs
                     tests/ManageDocks.hs
+                    tests/RotateSome.hs
                     tests/Selective.hs
                     tests/SwapWorkspaces.hs
                     tests/XPrompt.hs
@@ -124,6 +125,7 @@ library
                         XMonad.Actions.Plane
                         XMonad.Actions.Promote
                         XMonad.Actions.RandomBackground
+                        XMonad.Actions.RotateSome
                         XMonad.Actions.RotSlaves
                         XMonad.Actions.Search
                         XMonad.Actions.ShowText