{-# LANGUAGE ViewPatterns #-}

-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Actions.RotSlaves
-- Description  : Rotate all windows except the master window and keep the focus in place.
-- Copyright    : (c) Hans Philipp Annen <haphi@gmx.net>, Mischa Dieterle <der_m@freenet.de>
-- License      : BSD3-style (see LICENSE)
--
-- Maintainer   : Hans Philipp Annen <haphi@gmx.net>
-- Stability    : stable
-- Portability  : unportable
--
-- Rotate all windows except the master window and keep the focus in
-- place.
-----------------------------------------------------------------------------
module XMonad.Actions.RotSlaves (
        -- $usage
        rotSlaves', rotSlavesUp, rotSlavesDown,
        rotAll', rotAllUp, rotAllDown,

        -- * Generic list rotations
        -- $generic
        rotUp, rotDown
        ) where

import XMonad
import XMonad.StackSet
import XMonad.Prelude

-- $usage
--
-- To use this module, import it with:
--
-- > import XMonad.Actions.RotSlaves
--
-- and add whatever keybindings you would like, for example:
--
-- > , ((modm .|. shiftMask, xK_Tab   ), rotSlavesUp)
--
-- This operation will rotate all windows except the master window,
-- while the focus stays where it is. It is useful together with the
-- TwoPane layout (see "XMonad.Layout.TwoPane").
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

-- | Rotate the windows in the current stack, excluding the first one
--   (master).
rotSlavesUp,rotSlavesDown :: X ()
rotSlavesUp :: X ()
rotSlavesUp   = (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' (([Window] -> [Window]) -> Stack Window -> Stack Window
forall a. ([a] -> [a]) -> Stack a -> Stack a
rotSlaves' [Window] -> [Window]
forall a. [a] -> [a]
rotUp)
rotSlavesDown :: X ()
rotSlavesDown = (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' (([Window] -> [Window]) -> Stack Window -> Stack Window
forall a. ([a] -> [a]) -> Stack a -> Stack a
rotSlaves' [Window] -> [Window]
forall a. [a] -> [a]
rotDown)

-- | The actual rotation, as a pure function on the window stack.
rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
rotSlaves' :: forall a. ([a] -> [a]) -> Stack a -> Stack a
rotSlaves' [a] -> [a]
_ s :: Stack a
s@(Stack a
_ [] []) = Stack a
s
rotSlaves' [a] -> [a]
f   (Stack a
t [] [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
t [] ([a] -> [a]
f [a]
rs)                -- Master has focus
rotSlaves' [a] -> [a]
f s :: Stack a
s@(Stack a
_ [a]
ls [a]
_ ) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
t' ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
revls') [a]
rs'    -- otherwise
    where  ([a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> a
master :| [a]
ws)      = Stack a -> [a]
forall a. Stack a -> [a]
integrate Stack a
s
           ([a]
revls', [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> a
t' :| [a]
rs') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls) (a
mastera -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a]
f [a]
ws)

-- | Rotate all the windows in the current stack.
rotAllUp,rotAllDown :: X ()
rotAllUp :: X ()
rotAllUp   = (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' (([Window] -> [Window]) -> Stack Window -> Stack Window
forall a. ([a] -> [a]) -> Stack a -> Stack a
rotAll' [Window] -> [Window]
forall a. [a] -> [a]
rotUp)
rotAllDown :: X ()
rotAllDown = (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' (([Window] -> [Window]) -> Stack Window -> Stack Window
forall a. ([a] -> [a]) -> Stack a -> Stack a
rotAll' [Window] -> [Window]
forall a. [a] -> [a]
rotDown)

-- | The actual rotation, as a pure function on the window stack.
rotAll' :: ([a] -> [a]) -> Stack a -> Stack a
rotAll' :: forall a. ([a] -> [a]) -> Stack a -> Stack a
rotAll' [a] -> [a]
f Stack a
s = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
r ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
revls) [a]
rs
    where ([a]
revls, [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> a
r :| [a]
rs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Stack a -> [a]
forall a. Stack a -> [a]
up Stack a
s)) ([a] -> [a]
f (Stack a -> [a]
forall a. Stack a -> [a]
integrate Stack a
s))

-- $generic
-- Generic list rotations such that @rotUp [1..4]@ is equivalent to
-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are
-- @id@ for null or singleton lists.
rotUp :: [a] -> [a]
rotUp :: forall a. [a] -> [a]
rotUp   [a]
l = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
1 [a]
l
rotDown :: [a] -> [a]
rotDown :: forall a. [a] -> [a]
rotDown = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
rotUp ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse