    {-# LANGUAGE ViewPatterns #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.RotateSome
    -- Description :  Rotate some elements around the stack.
    -- 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 XMonad.Prelude (NonEmpty(..), notEmpty, 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)
    import XMonad.Util.Stack (reverseS)

    {- $usage
    You can use this module with the following in your @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 :: X ()
    surfaceNext = do
      ring <- X [Window]
    surfaceRing
      windows . modify' $ rotateSome (`elem` ring)

    -- | Like 'surfaceNext' in reverse.
    surfacePrev :: X ()
    surfacePrev :: X ()
    surfacePrev = do
      ring <- X [Window]
    surfaceRing
      windows . modify' $ reverseS . rotateSome (`elem` ring) . reverseS

    -- |
    -- 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 :: X [Window]
    surfaceRing = (WindowSet -> X [Window]) -> X [Window]
    forall a. (WindowSet -> X a) -> X a
    withWindowSet ((WindowSet -> X [Window]) -> X [Window])
    -> (WindowSet -> X [Window]) -> X [Window]
    forall a b. (a -> b) -> a -> b
    $ \WindowSet
    wset -> do
      let Screen Workspace WorkspaceId (Layout Window) Window
    wsp ScreenId
    _ ScreenDetail
    sd = WindowSet
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    current WindowSet
    wset

      case Workspace WorkspaceId (Layout Window) Window
    -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    stack Workspace WorkspaceId (Layout Window) Window
    wsp Maybe (Stack Window)
    -> (Stack Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Window -> Bool) -> Stack Window -> Maybe (Stack Window)
    forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
    filter' (Window -> Map Window RationalRect -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `M.notMember` WindowSet -> Map Window RationalRect
    forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
    floating WindowSet
    wset) of
        Maybe (Stack Window)
    Nothing -> [Window] -> X [Window]
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
        Just Stack Window
    st -> Stack Window -> [Window] -> [Window]
    go Stack Window
    st ([Window] -> [Window]) -> X [Window] -> X [Window]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Workspace WorkspaceId (Layout Window) Window
    -> Rectangle -> X [Window]
    layoutWindows Workspace WorkspaceId (Layout Window) Window
    wsp {stack = Just st} (ScreenDetail -> Rectangle
    screenRect ScreenDetail
    sd)
      where
        go :: Stack Window -> [Window] -> [Window]
        go :: Stack Window -> [Window] -> [Window]
    go (Stack Window
    t [Window]
    ls [Window]
    rs) [Window]
    shown = Window
    t Window -> [Window] -> [Window]
    forall a. a -> [a] -> [a]
    : (([Window]
    ls [Window] -> [Window] -> [Window]
    forall a. [a] -> [a] -> [a]
    ++ [Window]
    rs) [Window] -> [Window] -> [Window]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [Window]
    shown)

        layoutWindows :: WindowSpace -> Rectangle -> X [Window]
        layoutWindows :: Workspace WorkspaceId (Layout Window) Window
    -> Rectangle -> X [Window]
    layoutWindows Workspace WorkspaceId (Layout Window) Window
    wsp Rectangle
    rect = ((Window, Rectangle) -> Window)
    -> [(Window, Rectangle)] -> [Window]
    forall a b. (a -> b) -> [a] -> [b]
    map (Window, Rectangle) -> Window
    forall a b. (a, b) -> a
    fst ([(Window, Rectangle)] -> [Window])
    -> (([(Window, Rectangle)], Maybe (Layout Window))
        -> [(Window, Rectangle)])
    -> ([(Window, Rectangle)], Maybe (Layout Window))
    -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(Window, Rectangle)], Maybe (Layout Window))
    -> [(Window, Rectangle)]
    forall a b. (a, b) -> a
    fst (([(Window, Rectangle)], Maybe (Layout Window)) -> [Window])
    -> X ([(Window, Rectangle)], Maybe (Layout Window)) -> X [Window]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Workspace WorkspaceId (Layout Window) Window
    -> Rectangle -> X ([(Window, Rectangle)], Maybe (Layout Window))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    Workspace WorkspaceId (layout a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
    runLayout Workspace WorkspaceId (Layout Window) Window
    wsp Rectangle
    rect

    -- | Like "XMonad.StackSet.filter" but won't move focus.
    filter' :: (a -> Bool) -> Stack a -> Maybe (Stack a)
    filter' :: forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
    filter' a -> Bool
    p (Stack a
    f [a]
    ls [a]
    rs)
      | a -> Bool
    p a
    f       = Stack a -> Maybe (Stack a)
    forall a. a -> Maybe a
    Just (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
    forall a b. (a -> b) -> a -> b
    $ a -> [a] -> [a] -> Stack a
    forall a. a -> [a] -> [a] -> Stack a
    Stack a
    f ((a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter a -> Bool
    p [a]
    ls) ((a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter a -> Bool
    p [a]
    rs)
      | Bool
    otherwise = Maybe (Stack a)
    forall a. Maybe a
    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 :: forall a. (a -> Bool) -> Stack a -> Stack a
    rotateSome a -> Bool
    p (Stack a
    t [a]
    ls [a]
    rs) =
      let
        -- Flatten the stack, index each element relative to the focused position,
        -- then partition into movable and anchored elements.
        ([(Int, a)]
    movables, [(Int, a)]
    anchors) =
          ((Int, a) -> Bool) -> [(Int, a)] -> ([(Int, a)], [(Int, a)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (a -> Bool
    p (a -> Bool) -> ((Int, a) -> a) -> (Int, a) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, a) -> a
    forall a b. (a, b) -> b
    snd) ([(Int, a)] -> ([(Int, a)], [(Int, a)]))
    -> [(Int, a)] -> ([(Int, a)], [(Int, a)])
    forall a b. (a -> b) -> a -> b
    $
            [Int] -> [a] -> [(Int, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip
              [Int -> Int
    forall a. Num a => a -> a
    negate ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    ls)..]
              ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    ls [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ a
    t a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    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.
        ([a]
    ls', [a] -> NonEmpty a
    forall a. HasCallStack => [a] -> NonEmpty a
    notEmpty -> a
    t' :| [a]
    rs') =
          (((Int, a) -> a) -> [(Int, a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, a) -> a
    forall a b. (a, b) -> b
    snd ([(Int, a)] -> [a])
    -> ([(Int, a)] -> [a]) -> ([(Int, a)], [(Int, a)]) -> ([a], [a])
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** ((Int, a) -> a) -> [(Int, a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, a) -> a
    forall a b. (a, b) -> b
    snd)
            (([(Int, a)], [(Int, a)]) -> ([a], [a]))
    -> ([(Int, a)] -> ([(Int, a)], [(Int, a)]))
    -> [(Int, a)]
    -> ([a], [a])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Int, a) -> Bool) -> [(Int, a)] -> ([(Int, a)], [(Int, a)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span ((Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0) (Int -> Bool) -> ((Int, a) -> Int) -> (Int, a) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, a) -> Int
    forall a b. (a, b) -> a
    fst)
            ([(Int, a)] -> ([(Int, a)], [(Int, a)]))
    -> ([(Int, a)] -> [(Int, a)])
    -> [(Int, a)]
    -> ([(Int, a)], [(Int, a)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Int, a) -> Int) -> [(Int, a)] -> [(Int, a)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (Int, a) -> Int
    forall a b. (a, b) -> a
    fst
            ([(Int, a)] -> [(Int, a)])
    -> ([(Int, a)] -> [(Int, a)]) -> [(Int, a)] -> [(Int, a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Int, a)] -> [(Int, a)] -> [(Int, a)]
    forall a. [a] -> [a] -> [a]
    (++) [(Int, a)]
    anchors
            ([(Int, a)] -> ([a], [a])) -> [(Int, a)] -> ([a], [a])
    forall a b. (a -> b) -> a -> b
    $ ((Int, a) -> (Int, a) -> (Int, a))
    -> [(Int, a)] -> [(Int, a)] -> [(Int, a)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith ((((Int, a), (Int, a)) -> (Int, a))
    -> (Int, a) -> (Int, a) -> (Int, a)
    forall a b c. ((a, b) -> c) -> a -> b -> c
    curry ((Int, a) -> Int
    forall a b. (a, b) -> a
    fst ((Int, a) -> Int)
    -> ((Int, a) -> a) -> ((Int, a), (Int, a)) -> (Int, a)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** (Int, a) -> a
    forall a b. (a, b) -> b
    snd)) [(Int, a)]
    movables ([(Int, a)] -> [(Int, a)]
    forall a. [a] -> [a]
    rotate [(Int, a)]
    movables)
      in
        a -> [a] -> [a] -> Stack a
    forall a. a -> [a] -> [a] -> Stack a
    Stack a
    t' ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    ls') [a]
    rs'

    rotate :: [a] -> [a]
    rotate :: forall a. [a] -> [a]
    rotate = ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (([a] -> [a] -> [a]) -> [a] -> [a] -> [a]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++)) (([a], [a]) -> [a]) -> ([a] -> ([a], [a])) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    1