-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.Sift
-- Description :  Functions for sifting windows up and down.
-- 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 sifting windows up and down. Sifts behave identically to
-- swaps (i.e. 'swapUp' and 'swapDown' from "XMonad.StackSet"), except in
-- the wrapping case: rather than rotating the entire stack by one position
-- like a swap would, a sift causes the windows at either end of the stack
-- to trade positions.
--
-----------------------------------------------------------------------------

module XMonad.Actions.Sift (
    -- * Usage
    -- $usage
    siftUp,
    siftDown,
  ) where

import XMonad.StackSet (Stack (Stack), StackSet, modify')
import XMonad.Util.Stack (reverseS)

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.Sift
--
-- and add keybindings such as the following:
--
-- >   , ((modMask .|. shiftMask, xK_j ), windows siftDown)
-- >   , ((modMask .|. shiftMask, xK_k ), windows siftUp  )
--

-- |
-- siftUp, siftDown. Exchange the focused window with its neighbour in
-- the stack ordering, wrapping if we reach the end. Unlike 'swapUp' and
-- 'swapDown', wrapping is handled by trading positions with the window
-- at the other end of the stack.
--
siftUp, siftDown :: StackSet i l a s sd -> StackSet i l a s sd
siftUp :: forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
siftUp   = (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' Stack a -> Stack a
forall a. Stack a -> Stack a
siftUp'
siftDown :: forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
siftDown = (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' (Stack a -> Stack a
forall a. Stack a -> Stack a
reverseS (Stack a -> Stack a) -> (Stack a -> Stack a) -> Stack a -> Stack a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> Stack a
forall a. Stack a -> Stack a
siftUp' (Stack a -> Stack a) -> (Stack a -> Stack a) -> Stack a -> Stack a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> Stack a
forall a. Stack a -> Stack a
reverseS)

siftUp' :: Stack a -> Stack a
siftUp' :: forall a. Stack a -> Stack a
siftUp' (Stack a
t (a
l:[a]
ls) [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
t [a]
ls (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)
siftUp' (Stack a
t []     [a]
rs) =
  case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
rs of
    (a
x:[a]
xs) -> a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
t ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]) []
    []     -> a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
t []          []