-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.SwapPromote
-- Description :  Track the master window history per workspace.
-- Copyright   :  (c) 2018 Yclept Nemo
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :
-- Stability   :  unstable
-- Portability :  unportable
--
-- Module for tracking master window history per workspace, and associated
-- functions for manipulating the stack using such history.
--
-----------------------------------------------------------------------------


module XMonad.Actions.SwapPromote
    ( -- * Usage
      -- $usage
      MasterHistory (..)
      -- * State Accessors
    , getMasterHistoryMap
    , getMasterHistoryFromTag
    , getMasterHistoryCurrent
    , getMasterHistoryFromWindow
    , modifyMasterHistoryFromTag
    , modifyMasterHistoryCurrent
      -- * Log Hook
    , masterHistoryHook
      -- * Log Hook Building Blocks
    , masterHistoryHook'
    , updateMasterHistory
      -- * Actions
    , swapPromote
    , swapPromote'
    , swapIn
    , swapIn'
    , swapHybrid
    , swapHybrid'
      -- * Action Building Blocks
    , swapApply
    , swapPromoteStack
    , swapInStack
    , swapHybridStack
      -- * List Utilities
    , cycleN
    , split
    , split'
    , merge
    , merge'
      -- * Stack Utilities
    , stackSplit
    , stackMerge
    ) where


import           XMonad
import           XMonad.Prelude
import qualified XMonad.StackSet                as W
import qualified XMonad.Util.ExtensibleState    as XS

import qualified Data.Map                       as M
import qualified Data.Set                       as S
import           Control.Arrow
import qualified Data.List.NonEmpty             as NE


-- $usage
-- Given your configuration file, import this module:
--
-- > import XMonad.Actions.SwapPromote
--
-- First add 'masterHistoryHook' to your 'logHook' to track master windows per
-- workspace:
--
-- > myLogHook = otherHook >> masterHistoryHook
--
-- Then replace xmonad's default promote keybinding with 'swapPromote'':
--
-- > , ((mod1Mask, xK_Return), swapPromote' False)
--
-- Depending on your xmonad configuration or window actions the master history
-- may be empty. If this is the case you can still chain another promotion
-- function:
--
-- > import XMonad.Actions.DwmPromote
-- > , ((mod1Mask, xK_Return), whenX (swapPromote False) dwmpromote)
--
-- To be clear, this is only called when the lack of master history hindered
-- the swap and not other conditions, such as having a only a single window.
--
-- While 'swapPromote' preserves window focus, 'swapIn' preserves the focus
-- position - effectively "swapping" new windows into focus without moving the
-- zipper. A mix of both, 'swapHybrid' promotes focused non-master windows
-- while swapping windows into the focused master. This works well on layouts
-- with large masters. Both come with chainable variants, see 'swapIn'' and
-- 'swapHybrid''.
--
-- So far floating windows have been treated no differently than tiled windows
-- even though their positions are independent of the stack. Often, yanking
-- floating windows in and out of the workspace will obliterate the stack
-- history - particularly frustrating with "XMonad.Util.Scratchpad" since it is
-- toggled so frequenty and always replaces the master window. That's why the
-- swap functions accept a boolean argument; when @True@ non-focused floating
-- windows will be ignored.
--
-- All together:
--
-- > , ((mod1Mask, xK_Return), whenX (swapHybrid True) dwmpromote)


-- | Mapping from workspace tag to master history list. The current master is
-- the head of the list, the previous master the second element, and so on.
-- Without history, the list is empty.
newtype MasterHistory = MasterHistory
    { MasterHistory -> Map WorkspaceId [Window]
getMasterHistory :: M.Map WorkspaceId [Window]
    } deriving (ReadPrec [MasterHistory]
ReadPrec MasterHistory
Int -> ReadS MasterHistory
ReadS [MasterHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MasterHistory]
$creadListPrec :: ReadPrec [MasterHistory]
readPrec :: ReadPrec MasterHistory
$creadPrec :: ReadPrec MasterHistory
readList :: ReadS [MasterHistory]
$creadList :: ReadS [MasterHistory]
readsPrec :: Int -> ReadS MasterHistory
$creadsPrec :: Int -> ReadS MasterHistory
Read,Int -> MasterHistory -> ShowS
[MasterHistory] -> ShowS
MasterHistory -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [MasterHistory] -> ShowS
$cshowList :: [MasterHistory] -> ShowS
show :: MasterHistory -> WorkspaceId
$cshow :: MasterHistory -> WorkspaceId
showsPrec :: Int -> MasterHistory -> ShowS
$cshowsPrec :: Int -> MasterHistory -> ShowS
Show)

instance ExtensionClass MasterHistory where
    initialValue :: MasterHistory
initialValue = Map WorkspaceId [Window] -> MasterHistory
MasterHistory forall k a. Map k a
M.empty

-- | Return the master history map from the state.
getMasterHistoryMap :: X (M.Map WorkspaceId [Window])
getMasterHistoryMap :: X (Map WorkspaceId [Window])
getMasterHistoryMap = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets MasterHistory -> Map WorkspaceId [Window]
getMasterHistory

-- | Return the master history list of a given tag. The master history list may
-- be empty. An invalid tag will also result in an empty list.
getMasterHistoryFromTag :: WorkspaceId -> X [Window]
getMasterHistoryFromTag :: WorkspaceId -> X [Window]
getMasterHistoryFromTag WorkspaceId
t = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] WorkspaceId
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (Map WorkspaceId [Window])
getMasterHistoryMap

-- | Return the master history list of the current workspace.
getMasterHistoryCurrent :: X [Window]
getMasterHistoryCurrent :: X [Window]
getMasterHistoryCurrent =   forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
                        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X [Window]
getMasterHistoryFromTag

-- | Return the master history list of the workspace containing the given
-- window. Return an empty list if the window is not in the stackset.
getMasterHistoryFromWindow :: Window -> X [Window]
getMasterHistoryFromWindow :: Window -> X [Window]
getMasterHistoryFromWindow Window
w =   forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
                             forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return []) WorkspaceId -> X [Window]
getMasterHistoryFromTag

-- | Modify the master history list of a given workspace, or the empty list of
-- no such workspace is mapped. The result is then re-inserted into the master
-- history map.
modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()
modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()
modifyMasterHistoryFromTag WorkspaceId
t [Window] -> [Window]
f = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall a b. (a -> b) -> a -> b
$ \(MasterHistory Map WorkspaceId [Window]
m) ->
    let l :: [Window]
l = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] WorkspaceId
t Map WorkspaceId [Window]
m
    in  Map WorkspaceId [Window] -> MasterHistory
MasterHistory forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
t ([Window] -> [Window]
f [Window]
l) Map WorkspaceId [Window]
m

-- | Modify the master history list of the current workspace. While the current
-- workspace is guaranteed to exist; its master history may not. For more
-- information see 'modifyMasterHistoryFromTag'.
modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()
modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()
modifyMasterHistoryCurrent [Window] -> [Window]
f =   forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
                             forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip WorkspaceId -> ([Window] -> [Window]) -> X ()
modifyMasterHistoryFromTag [Window] -> [Window]
f

-- | A 'logHook' to update the master history mapping. Non-existent workspaces
-- are removed, and the master history list for the current workspaces is
-- updated. See 'masterHistoryHook''.
masterHistoryHook :: X ()
masterHistoryHook :: X ()
masterHistoryHook = Bool -> ([Window] -> [Window] -> [Window]) -> X ()
masterHistoryHook' Bool
True [Window] -> [Window] -> [Window]
updateMasterHistory

-- | Backend for 'masterHistoryHook'.
masterHistoryHook' :: Bool
                        -- ^ If @True@, remove non-existent workspaces.
                   -> ([Window] -> [Window] -> [Window])
                        -- ^ Function used to update the master history list of
                        -- the current workspace. First argument is the master
                        -- history, second is the integrated stack.  See
                        -- 'updateMasterHistory' for more details.
                   -> X ()
masterHistoryHook' :: Bool -> ([Window] -> [Window] -> [Window]) -> X ()
masterHistoryHook' Bool
removeWorkspaces [Window] -> [Window] -> [Window]
historyModifier = do
    WindowSet
wset <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    let W.Workspace WorkspaceId
wid Layout Window
_ Maybe (Stack Window)
mst = forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall a b. (a -> b) -> a -> b
$ WindowSet
wset
        tags :: [WorkspaceId]
tags = forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
W.tag forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
wset
        st :: [Window]
st = forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack Window)
mst
    forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall a b. (a -> b) -> a -> b
$ \(MasterHistory Map WorkspaceId [Window]
mm) ->
        let mm' :: Map WorkspaceId [Window]
mm' = if Bool
removeWorkspaces
                  then forall k a. Ord k => Map k a -> Set k -> Map k a
restrictKeys Map WorkspaceId [Window]
mm forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [WorkspaceId]
tags
                  else Map WorkspaceId [Window]
mm
            ms :: [Window]
ms  = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] WorkspaceId
wid Map WorkspaceId [Window]
mm'
            ms' :: [Window]
ms' = [Window] -> [Window] -> [Window]
historyModifier [Window]
ms [Window]
st
        in  Map WorkspaceId [Window] -> MasterHistory
MasterHistory forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
wid [Window]
ms' Map WorkspaceId [Window]
mm'

-- | Less efficient version of 'M.restrictKeys'. Given broader eventual
-- adoption, replace this with 'M.restrictKeys'.
restrictKeys :: Ord k => M.Map k a -> S.Set k -> M.Map k a
restrictKeys :: forall k a. Ord k => Map k a -> Set k -> Map k a
restrictKeys Map k a
m Set k
s = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\k
k a
_ -> k
k forall a. Ord a => a -> Set a -> Bool
`S.member` Set k
s) Map k a
m

-- | Given the current master history list and an integrated stack, return the
-- new master history list. The current master is either moved (if it exists
-- within the history) or added to the head of the list, and all missing (i.e.
-- closed) windows are removed.
updateMasterHistory :: [Window] -- ^ The master history list.
                    -> [Window] -- ^ The integrated stack.
                    -> [Window]
updateMasterHistory :: [Window] -> [Window] -> [Window]
updateMasterHistory [Window]
_  []       = []
updateMasterHistory [Window]
ms ws :: [Window]
ws@(Window
w:[Window]
_) = (Window
w forall a. a -> [a] -> [a]
: forall a. Eq a => a -> [a] -> [a]
delete Window
w [Window]
ms) forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Window]
ws

-- | Wrap 'swapPromoteStack'; see also 'swapApply'.
swapPromote :: Bool -> X Bool
swapPromote :: Bool -> X Bool
swapPromote = forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool
-> (Maybe Window -> Stack Window -> (Bool, Stack Window)) -> X Bool
swapApply Maybe Window -> Stack Window -> (Bool, Stack Window)
swapPromoteStack

-- | Like 'swapPromote'' but discard the result.
swapPromote' :: Bool -> X ()
swapPromote' :: Bool -> X ()
swapPromote' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> X Bool
swapPromote

-- | Wrap 'swapInStack'; see also 'swapApply'.
swapIn :: Bool -> X Bool
swapIn :: Bool -> X Bool
swapIn = forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool
-> (Maybe Window -> Stack Window -> (Bool, Stack Window)) -> X Bool
swapApply Maybe Window -> Stack Window -> (Bool, Stack Window)
swapInStack

-- | Like 'swapIn'' but discard the result.
swapIn' :: Bool -> X ()
swapIn' :: Bool -> X ()
swapIn' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> X Bool
swapIn

-- | Wrap 'swapHybridStack'; see also 'swapApply'.
swapHybrid :: Bool -> X Bool
swapHybrid :: Bool -> X Bool
swapHybrid = forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool
-> (Maybe Window -> Stack Window -> (Bool, Stack Window)) -> X Bool
swapApply Maybe Window -> Stack Window -> (Bool, Stack Window)
swapHybridStack

-- | Like 'swapHybrid'' but discard the result.
swapHybrid' :: Bool -> X ()
swapHybrid' :: Bool -> X ()
swapHybrid' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> X Bool
swapHybrid

-- | Apply the given master history stack modifier to the current stack. If
-- given @True@, all non-focused floating windows will be ignored. Return
-- @True@ if insufficient history; if so use 'whenX' to sequence a backup
-- promotion function.
swapApply :: Bool
          -> (Maybe Window -> W.Stack Window -> (Bool,W.Stack Window))
          -> X Bool
swapApply :: Bool
-> (Maybe Window -> Stack Window -> (Bool, Stack Window)) -> X Bool
swapApply Bool
ignoreFloats Maybe Window -> Stack Window -> (Bool, Stack Window)
swapFunction = do
    Map Window RationalRect
fl <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
    Maybe (Stack Window)
st <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
    [Window]
ch <- X [Window]
getMasterHistoryCurrent
    let swapApply' :: Stack Window -> (Bool, Maybe (Stack Window), b -> [Window])
swapApply' Stack Window
s1 =
            let fl' :: Set Window
fl' = if Bool
ignoreFloats then forall k a. Map k a -> Set k
M.keysSet Map Window RationalRect
fl else forall a. Set a
S.empty
                ff :: Window -> Bool
ff = Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Window
fl') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Eq a => a -> a -> Bool
== forall a. Stack a -> a
W.focus Stack Window
s1)
                fh :: [Window]
fh = forall a. (a -> Bool) -> [a] -> [a]
filter Window -> Bool
ff [Window]
ch
                pm :: Maybe Window
pm = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ [Window]
fh
                ([(Int, Window)]
r,Stack Window
s2) = forall a b.
(Num a, Enum a, Ord b) =>
Stack b -> Set b -> ([(a, b)], Stack b)
stackSplit Stack Window
s1 Set Window
fl' :: ([(Int,Window)],W.Stack Window)
                (Bool
b,Stack Window
s3) = Maybe Window -> Stack Window -> (Bool, Stack Window)
swapFunction Maybe Window
pm Stack Window
s2
                s4 :: Stack Window
s4 = forall a b. (Ord a, Num a) => Stack b -> [(a, b)] -> Stack b
stackMerge Stack Window
s3 [(Int, Window)]
r
                mh :: b -> [Window]
mh = let w :: Window
w = forall a. NonEmpty a -> a
NE.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => [a] -> NonEmpty a
notEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
W.integrate forall a b. (a -> b) -> a -> b
$ Stack Window
s3
                     in forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Window
w forall a. a -> [a] -> [a]
: forall a. Eq a => a -> [a] -> [a]
delete Window
w [Window]
ch
            in (Bool
b,forall a. a -> Maybe a
Just Stack Window
s4,forall {b}. b -> [Window]
mh)
        (Bool
x,Maybe (Stack Window)
y,[Window] -> [Window]
z) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False,forall a. Maybe a
Nothing,forall a. a -> a
id) forall {b}.
Stack Window -> (Bool, Maybe (Stack Window), b -> [Window])
swapApply' Maybe (Stack Window)
st
    -- Any floating master windows will be added to the history when 'windows'
    -- calls the log hook.
    ([Window] -> [Window]) -> X ()
modifyMasterHistoryCurrent [Window] -> [Window]
z
    (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a i l s sd.
Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
W.modify forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window)
y
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x

-- | If the focused window is the master window and there is no previous
-- master, do nothing. Otherwise swap the master with the previous master. If
-- the focused window is not the master window, swap it with the master window.
-- In either case focus follows the original window, i.e. the focused window
-- does not change, only its position.
--
-- The first argument is the previous master (which may not exist), the second
-- a window stack. Return @True@ if the master history hindered the swap; the
-- history is either empty or out-of-sync. Though the latter shouldn't happen
-- this function never changes the stack under such circumstances.
swapPromoteStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapPromoteStack :: Maybe Window -> Stack Window -> (Bool, Stack Window)
swapPromoteStack Maybe Window
_         st :: Stack Window
st@(W.Stack Window
_x [] []) = (Bool
False,Stack Window
st)
swapPromoteStack Maybe Window
Nothing   st :: Stack Window
st@(W.Stack Window
_x [] [Window]
_r) = (Bool
True,Stack Window
st)
swapPromoteStack (Just Window
pm)    (W.Stack  Window
x []  [Window]
r) =
    let ([Window]
r',[Window]
l') = (forall a. [a] -> [a]
reverse forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. Int -> [a] -> [a]
cycleN Int
1) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Window
pm) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Window]
r
        st' :: Stack Window
st'     = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x [Window]
l' [Window]
r'
        b :: Bool
b       = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Window]
l'
    in  (Bool
b,Stack Window
st')
swapPromoteStack Maybe Window
_            (W.Stack  Window
x [Window]
l   [Window]
r) =
    let r' :: [Window]
r'  = (forall a. [a] -> [a] -> [a]
++ [Window]
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
cycleN Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Window]
l
        st' :: Stack Window
st' = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x [] [Window]
r'
    in  (Bool
False,Stack Window
st')

-- | Perform the same swap as 'swapPromoteStack'. However the new window
-- receives the focus; it appears to "swap into" the position of the original
-- window. Under this model focus follows stack position and the zipper does
-- not move.
--
-- See 'swapPromoteStack' for more details regarding the parameters.
swapInStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapInStack :: Maybe Window -> Stack Window -> (Bool, Stack Window)
swapInStack Maybe Window
_         st :: Stack Window
st@(W.Stack Window
_x [] []) = (Bool
False,Stack Window
st)
swapInStack Maybe Window
Nothing   st :: Stack Window
st@(W.Stack Window
_x [] [Window]
_r) = (Bool
True,Stack Window
st)
swapInStack (Just Window
pm)    (W.Stack  Window
x []  [Window]
r) =
    let (Window
x',[Window]
r') = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Window
pm) [Window]
r of
            ([Window]
__,[]) -> (Window
x,[Window]
r)
            ([Window]
sl,[Window]
sr) -> (Window
pm,[Window]
sl forall a. [a] -> [a] -> [a]
++ Window
x forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
drop Int
1 [Window]
sr)
        st' :: Stack Window
st'     = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x' [] [Window]
r'
        b :: Bool
b       = Window
x' forall a. Eq a => a -> a -> Bool
== Window
x
    in  (Bool
b,Stack Window
st')
swapInStack Maybe Window
_            (W.Stack  Window
x [Window]
l   [Window]
r) =
    let l' :: [Window]
l'  = forall a. [a] -> [a]
init [Window]
l forall a. [a] -> [a] -> [a]
++ [Window
x]
        x' :: Window
x'  = forall a. [a] -> a
last [Window]
l
        st' :: Stack Window
st' = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x' [Window]
l' [Window]
r
    in  (Bool
False,Stack Window
st')

-- | If the focused window is the master window, use 'swapInStack'. Otherwise use
-- 'swapPromoteStack'.
--
-- See 'swapPromoteStack' for more details regarding the parameters.
swapHybridStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapHybridStack :: Maybe Window -> Stack Window -> (Bool, Stack Window)
swapHybridStack Maybe Window
m st :: Stack Window
st@(W.Stack Window
_ [] [Window]
_) = Maybe Window -> Stack Window -> (Bool, Stack Window)
swapInStack Maybe Window
m Stack Window
st
swapHybridStack Maybe Window
m Stack Window
st                  = Maybe Window -> Stack Window -> (Bool, Stack Window)
swapPromoteStack Maybe Window
m Stack Window
st

-- | Cycle a list by the given count. If positive, cycle to the left. If
-- negative, cycle to the right:
--
-- >>> cycleN 2 [1,2,3,4,5]
-- [3,4,5,1,2]
-- >>> cycleN (-2) [1,2,3,4,5]
-- [4,5,1,2,3]
cycleN :: Int -> [a] -> [a]
cycleN :: forall a. Int -> [a] -> [a]
cycleN Int
n [a]
ls =
    let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls
    in  forall a. Int -> [a] -> [a]
take Int
l forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (Int
n forall a. Integral a => a -> a -> a
`mod` Int
l) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [a]
ls

-- | Wrap 'split'' with an initial index of @0@, discarding the list's length.
split :: (Num a, Enum a) => (b -> Bool) -> [b] -> ([(a,b)],[b])
split :: forall a b.
(Num a, Enum a) =>
(b -> Bool) -> [b] -> ([(a, b)], [b])
split b -> Bool
p [b]
l =
    let (a
_,[(a, b)]
ys,[b]
ns) = forall a b.
(Num a, Enum a) =>
(b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
split' b -> Bool
p a
0 [b]
l
    in  ([(a, b)]
ys,[b]
ns)

-- | Given a predicate, an initial index and a list, return a tuple containing:
--
--  * List length.
--  * Indexed list of elements which satisfy the predicate. An indexed element
--    is a tuple containing the element index (offset by the initial index) and
--    the element.
--  * List of elements which do not satisfy the predicate.
--
-- The initial index and length of the list simplify chaining calls to this
-- function, such as for zippers of lists.
split' :: (Num a, Enum a) => (b -> Bool) -> a -> [b] -> (a,[(a,b)],[b])
split' :: forall a b.
(Num a, Enum a) =>
(b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
split' b -> Bool
p a
i [b]
l =
    let accumulate :: (a, b) -> (a, [(a, b)], [(a, b)]) -> (a, [(a, b)], [(a, b)])
accumulate (a, b)
e (a
c,[(a, b)]
ys,[(a, b)]
ns) = if b -> Bool
p (forall a b. (a, b) -> b
snd (a, b)
e)
            then (a
cforall a. Num a => a -> a -> a
+a
1,(a, b)
eforall a. a -> [a] -> [a]
:[(a, b)]
ys,[(a, b)]
ns)
            else (a
cforall a. Num a => a -> a -> a
+a
1,[(a, b)]
ys,(a, b)
eforall a. a -> [a] -> [a]
:[(a, b)]
ns)
        (a
c',[(a, b)]
ys',[(a, b)]
ns') = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}.
Num a =>
(a, b) -> (a, [(a, b)], [(a, b)]) -> (a, [(a, b)], [(a, b)])
accumulate (a
0,[],[]) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [a
i..] [b]
l
    in  (a
c',[(a, b)]
ys',forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
ns')

-- | Wrap 'merge'' with an initial virtual index of @0@. Return only the
-- unindexed list with elements from the leftover indexed list appended.
merge :: (Ord a, Num a) => [(a,b)] -> [b] -> [b]
merge :: forall a b. (Ord a, Num a) => [(a, b)] -> [b] -> [b]
merge [(a, b)]
il [b]
ul =
    let (a
_,[(a, b)]
il',[b]
ul') = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' a
0 [(a, b)]
il [b]
ul
    in  [b]
ul' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
il'

-- | Inverse of 'split'. Merge an indexed list with an unindexed list (see
-- 'split''). Given a virtual index, an indexed list and an unindexed list,
-- return a tuple containing:
--
--  * Virtual index /after/ the unindexed list
--  * Remainder of the indexed list
--  * Merged unindexed list
--
-- If the indexed list is empty, this functions consumes the entire unindexed
-- list. If the unindexed list is empty, this function consumes only adjacent
-- indexed elements. For example, @[(10,"ten"),(12,"twelve")]@ implies missing
-- unindexed elements and so once @(10,"ten")@ is consumed this function
-- concludes.
--
-- The indexed list is assumed to have been created by 'split'' and not checked
-- for correctness. Indices are assumed to be ascending, i.e.
-- > [(1,"one"),(2,"two"),(4,"four")]
--
-- The initial and final virtual indices simplify chaining calls to the this
-- function, as as for zippers of lists. Positive values shift the unindexed
-- list towards the tail, as if preceded by that many elements.
merge' :: (Ord a, Num a) => a -> [(a,b)] -> [b] -> (a,[(a,b)],[b])
merge' :: forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' a
i il :: [(a, b)]
il@((a
j,b
a):[(a, b)]
ps) ul :: [b]
ul@(b
b:[b]
bs) = if a
j forall a. Ord a => a -> a -> Bool
<= a
i
    then let (a
x,[(a, b)]
y,[b]
z) = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
iforall a. Num a => a -> a -> a
+a
1) [(a, b)]
ps [b]
ul
         in  (a
x,[(a, b)]
y,b
aforall a. a -> [a] -> [a]
:[b]
z)
    else let (a
x,[(a, b)]
y,[b]
z) = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
iforall a. Num a => a -> a -> a
+a
1) [(a, b)]
il [b]
bs
         in  (a
x,[(a, b)]
y,b
bforall a. a -> [a] -> [a]
:[b]
z)
merge' a
i [] (b
b:[b]
bs) =
         let (a
x,[(a, b)]
y,[b]
z) = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
iforall a. Num a => a -> a -> a
+a
1) [] [b]
bs
         in  (a
x,[(a, b)]
y,b
bforall a. a -> [a] -> [a]
:[b]
z)
merge' a
i il :: [(a, b)]
il@((a
j,b
a):[(a, b)]
ps) [] = if a
j forall a. Ord a => a -> a -> Bool
<= a
i
    then let (a
x,[(a, b)]
y,[b]
z) = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
iforall a. Num a => a -> a -> a
+a
1) [(a, b)]
ps []
         in  (a
x,[(a, b)]
y,b
aforall a. a -> [a] -> [a]
:[b]
z)
    else (a
i,[(a, b)]
il,[])
merge' a
i [] [] =
         (a
i,[],[])

-- | Remove all elements of the set from the stack. Skip the currently focused
-- member. Return an indexed list of excluded elements and the modified stack.
-- Use 'stackMerge' to re-insert the elements using this list.
stackSplit :: (Num a, Enum a, Ord b) => W.Stack b -> S.Set b -> ([(a,b)],W.Stack b)
stackSplit :: forall a b.
(Num a, Enum a, Ord b) =>
Stack b -> Set b -> ([(a, b)], Stack b)
stackSplit (W.Stack b
x [b]
l [b]
r) Set b
s =
    let (a
c,[(a, b)]
fl,[b]
tl) = forall a b.
(Num a, Enum a) =>
(b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
split' (forall a. Ord a => a -> Set a -> Bool
`S.member` Set b
s) a
0 (forall a. [a] -> [a]
reverse [b]
l)
        (a
_,[(a, b)]
fr,[b]
tr) = forall a b.
(Num a, Enum a) =>
(b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
split' (forall a. Ord a => a -> Set a -> Bool
`S.member` Set b
s) (a
cforall a. Num a => a -> a -> a
+a
1) [b]
r
    in  ([(a, b)]
flforall a. [a] -> [a] -> [a]
++[(a, b)]
fr,forall a. a -> [a] -> [a] -> Stack a
W.Stack b
x (forall a. [a] -> [a]
reverse [b]
tl) [b]
tr)

-- | Inverse of 'stackSplit'. Given a list of elements and their original
-- indices, re-insert the elements into these same positions within the stack.
-- Skip the currently focused member. Works best if the stack's length hasn't
-- changed, though if shorter any leftover elements will be tacked on.
stackMerge :: (Ord a, Num a) => W.Stack b -> [(a,b)] -> W.Stack b
stackMerge :: forall a b. (Ord a, Num a) => Stack b -> [(a, b)] -> Stack b
stackMerge (W.Stack b
x [b]
l [b]
r) [(a, b)]
il =
    let (a
i,[(a, b)]
il1,[b]
l') = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' a
0 [(a, b)]
il (forall a. [a] -> [a]
reverse [b]
l)
        (a
_,[(a, b)]
il2,[b]
r') = forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
iforall a. Num a => a -> a -> a
+a
1) [(a, b)]
il1 [b]
r
    in  forall a. a -> [a] -> [a] -> Stack a
W.Stack b
x (forall a. [a] -> [a]
reverse [b]
l') ([b]
r' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
il2)