{-# 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
  [Window]
ring <- X [Window]
surfaceRing
  (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Stack a -> Stack a
rotateSome (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ring)

-- | Like 'surfaceNext' in reverse.
surfacePrev :: X ()
surfacePrev :: X ()
surfacePrev = do
  [Window]
ring <- X [Window]
surfaceRing
  (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> Stack a
reverseS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Stack a -> Stack a
rotateSome (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ring) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> Stack a
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 = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
wset -> do
  let Screen Workspace WorkspaceId (Layout Window) Window
wsp ScreenId
_ ScreenDetail
sd = forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current WindowSet
wset

  case forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace WorkspaceId (Layout Window) Window
wsp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
filter' (forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
floating WindowSet
wset) of
    Maybe (Stack Window)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just Stack Window
st -> Stack Window -> [Window] -> [Window]
go Stack Window
st 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 :: Maybe (Stack Window)
stack = forall a. a -> Maybe a
Just Stack Window
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 forall a. a -> [a] -> [a]
: (([Window]
ls forall a. [a] -> [a] -> [a]
++ [Window]
rs) 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
Stack a
f (forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
ls) (forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
rs)
  | Bool
otherwise = 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) =
      forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
        forall a b. [a] -> [b] -> [(a, b)]
zip
          [forall a. Num a => a -> a
negate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls)..]
          (forall a. [a] -> [a]
reverse [a]
ls forall a. [a] -> [a] -> [a]
++ a
t 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', forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> a
t' :| [a]
rs') =
      (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Ord a => a -> a -> Bool
< Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) [(Int, a)]
anchors
        forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b. (a, b) -> b
snd)) [(Int, a)]
movables (forall a. [a] -> [a]
rotate [(Int, a)]
movables)
  in
    forall a. a -> [a] -> [a] -> Stack a
Stack a
t' (forall a. [a] -> [a]
reverse [a]
ls') [a]
rs'

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