-----------------------------------------------------------------------------
-- |
-- 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


-- $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]
(Int -> ReadS MasterHistory)
-> ReadS [MasterHistory]
-> ReadPrec MasterHistory
-> ReadPrec [MasterHistory]
-> Read 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
(Int -> MasterHistory -> ShowS)
-> (MasterHistory -> WorkspaceId)
-> ([MasterHistory] -> ShowS)
-> Show MasterHistory
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 Map WorkspaceId [Window]
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 = (MasterHistory -> Map WorkspaceId [Window])
-> X (Map WorkspaceId [Window])
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 = [Window] -> WorkspaceId -> Map WorkspaceId [Window] -> [Window]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] WorkspaceId
t (Map WorkspaceId [Window] -> [Window])
-> X (Map WorkspaceId [Window]) -> X [Window]
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 =   (XState -> WorkspaceId) -> X WorkspaceId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
                        X WorkspaceId -> (WorkspaceId -> X [Window]) -> X [Window]
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 =   (XState -> Maybe WorkspaceId) -> X (Maybe WorkspaceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Window
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Maybe WorkspaceId
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Maybe WorkspaceId)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Maybe WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
                             X (Maybe WorkspaceId)
-> (Maybe WorkspaceId -> X [Window]) -> X [Window]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= X [Window]
-> (WorkspaceId -> X [Window]) -> Maybe WorkspaceId -> X [Window]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Window] -> X [Window]
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 = (MasterHistory -> MasterHistory) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((MasterHistory -> MasterHistory) -> X ())
-> (MasterHistory -> MasterHistory) -> X ()
forall a b. (a -> b) -> a -> b
$ \(MasterHistory Map WorkspaceId [Window]
m) ->
    let l :: [Window]
l = [Window] -> WorkspaceId -> Map WorkspaceId [Window] -> [Window]
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 (Map WorkspaceId [Window] -> MasterHistory)
-> Map WorkspaceId [Window] -> MasterHistory
forall a b. (a -> b) -> a -> b
$ WorkspaceId
-> [Window] -> Map WorkspaceId [Window] -> Map WorkspaceId [Window]
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 =   (XState -> WorkspaceId) -> X WorkspaceId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
                             X WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WorkspaceId -> ([Window] -> [Window]) -> X ())
-> ([Window] -> [Window]) -> WorkspaceId -> X ()
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
    StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
wset <- (XState
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
    let W.Workspace WorkspaceId
wid Layout Window
_ Maybe (Stack Window)
mst = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> (StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> 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
W.current (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
wset
        tags :: [WorkspaceId]
tags = (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> [Workspace WorkspaceId (Layout Window) Window] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag ([Workspace WorkspaceId (Layout Window) Window] -> [WorkspaceId])
-> [Workspace WorkspaceId (Layout Window) Window] -> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Workspace WorkspaceId (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
wset
        st :: [Window]
st = Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack Window)
mst
    (MasterHistory -> MasterHistory) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((MasterHistory -> MasterHistory) -> X ())
-> (MasterHistory -> MasterHistory) -> X ()
forall a b. (a -> b) -> a -> b
$ \(MasterHistory Map WorkspaceId [Window]
mm) ->
        let mm' :: Map WorkspaceId [Window]
mm' = if Bool
removeWorkspaces
                  then Map WorkspaceId [Window]
-> Set WorkspaceId -> Map WorkspaceId [Window]
forall k a. Ord k => Map k a -> Set k -> Map k a
restrictKeys Map WorkspaceId [Window]
mm (Set WorkspaceId -> Map WorkspaceId [Window])
-> Set WorkspaceId -> Map WorkspaceId [Window]
forall a b. (a -> b) -> a -> b
$ [WorkspaceId] -> Set WorkspaceId
forall a. Ord a => [a] -> Set a
S.fromList [WorkspaceId]
tags
                  else Map WorkspaceId [Window]
mm
            ms :: [Window]
ms  = [Window] -> WorkspaceId -> Map WorkspaceId [Window] -> [Window]
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 (Map WorkspaceId [Window] -> MasterHistory)
-> Map WorkspaceId [Window] -> MasterHistory
forall a b. (a -> b) -> a -> b
$ WorkspaceId
-> [Window] -> Map WorkspaceId [Window] -> Map WorkspaceId [Window]
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 :: Map k a -> Set k -> Map k a
restrictKeys Map k a
m Set k
s = (k -> a -> Bool) -> Map k a -> Map k a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\k
k a
_ -> k
k k -> Set k -> Bool
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 Window -> [Window] -> [Window]
forall a. a -> [a] -> [a]
: Window -> [Window] -> [Window]
forall a. Eq a => a -> [a] -> [a]
delete Window
w [Window]
ms) [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Window]
ws

-- | Wrap 'swapPromoteStack'; see also 'swapApply'.
swapPromote :: Bool -> X Bool
swapPromote :: Bool -> X Bool
swapPromote = (Bool
 -> (Maybe Window -> Stack Window -> (Bool, Stack Window))
 -> X Bool)
-> (Maybe Window -> Stack Window -> (Bool, Stack Window))
-> Bool
-> X Bool
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' = X Bool -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Bool -> X ()) -> (Bool -> X Bool) -> Bool -> X ()
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 = (Bool
 -> (Maybe Window -> Stack Window -> (Bool, Stack Window))
 -> X Bool)
-> (Maybe Window -> Stack Window -> (Bool, Stack Window))
-> Bool
-> X Bool
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' = X Bool -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Bool -> X ()) -> (Bool -> X Bool) -> Bool -> X ()
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 = (Bool
 -> (Maybe Window -> Stack Window -> (Bool, Stack Window))
 -> X Bool)
-> (Maybe Window -> Stack Window -> (Bool, Stack Window))
-> Bool
-> X Bool
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' = X Bool -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Bool -> X ()) -> (Bool -> X Bool) -> Bool -> X ()
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 <- (XState -> Map Window RationalRect) -> X (Map Window RationalRect)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> Map Window RationalRect)
 -> X (Map Window RationalRect))
-> (XState -> Map Window RationalRect)
-> X (Map Window RationalRect)
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Map Window RationalRect)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Map Window RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
    Maybe (Stack Window)
st <- (XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window)))
-> (XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall a b. (a -> b) -> a -> b
$ Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace WorkspaceId (Layout Window) Window
 -> Maybe (Stack Window))
-> (XState -> Workspace WorkspaceId (Layout Window) Window)
-> XState
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> (XState
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> 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
W.current (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
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 Map Window RationalRect -> Set Window
forall k a. Map k a -> Set k
M.keysSet Map Window RationalRect
fl else Set Window
forall a. Set a
S.empty
                ff :: Window -> Bool
ff = Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool)
-> (Window -> Bool) -> Window -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Window -> Set Window -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Window
fl') (Window -> Bool -> Bool) -> (Window -> Bool) -> Window -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
s1)
                fh :: [Window]
fh = (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter Window -> Bool
ff [Window]
ch
                pm :: Maybe Window
pm = [Window] -> Maybe Window
forall a. [a] -> Maybe a
listToMaybe ([Window] -> Maybe Window)
-> ([Window] -> [Window]) -> [Window] -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Window] -> [Window]
forall a. Int -> [a] -> [a]
drop Int
1 ([Window] -> Maybe Window) -> [Window] -> Maybe Window
forall a b. (a -> b) -> a -> b
$ [Window]
fh
                ([(Int, Window)]
r,Stack Window
s2) = Stack Window -> Set Window -> ([(Int, Window)], Stack Window)
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 = Stack Window -> [(Int, Window)] -> Stack Window
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 = [Window] -> Window
forall a. [a] -> a
head ([Window] -> Window)
-> (Stack Window -> [Window]) -> Stack Window -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate (Stack Window -> Window) -> Stack Window -> Window
forall a b. (a -> b) -> a -> b
$ Stack Window
s3
                     in  [Window] -> b -> [Window]
forall a b. a -> b -> a
const ([Window] -> b -> [Window]) -> [Window] -> b -> [Window]
forall a b. (a -> b) -> a -> b
$ Window
w Window -> [Window] -> [Window]
forall a. a -> [a] -> [a]
: Window -> [Window] -> [Window]
forall a. Eq a => a -> [a] -> [a]
delete Window
w [Window]
ch
            in (Bool
b,Stack Window -> Maybe (Stack Window)
forall a. a -> Maybe a
Just Stack Window
s4,b -> [Window]
forall b. b -> [Window]
mh)
        (Bool
x,Maybe (Stack Window)
y,[Window] -> [Window]
z) = (Bool, Maybe (Stack Window), [Window] -> [Window])
-> (Stack Window
    -> (Bool, Maybe (Stack Window), [Window] -> [Window]))
-> Maybe (Stack Window)
-> (Bool, Maybe (Stack Window), [Window] -> [Window])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False,Maybe (Stack Window)
forall a. Maybe a
Nothing,[Window] -> [Window]
forall a. a -> a
id) Stack Window -> (Bool, Maybe (Stack Window), [Window] -> [Window])
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
    (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window))
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
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 Maybe (Stack Window)
forall a. Maybe a
Nothing ((Stack Window -> Maybe (Stack Window))
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (Maybe (Stack Window) -> Stack Window -> Maybe (Stack Window))
-> Maybe (Stack Window)
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack Window) -> Stack Window -> Maybe (Stack Window)
forall a b. a -> b -> a
const (Maybe (Stack Window)
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Maybe (Stack Window)
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window)
y
    Bool -> X Bool
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') = ([Window] -> [Window]
forall a. [a] -> [a]
reverse ([Window] -> [Window])
-> ([Window] -> [Window])
-> ([Window], [Window])
-> ([Window], [Window])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int -> [Window] -> [Window]
forall a. Int -> [a] -> [a]
cycleN Int
1) (([Window], [Window]) -> ([Window], [Window]))
-> ([Window], [Window]) -> ([Window], [Window])
forall a b. (a -> b) -> a -> b
$ (Window -> Bool) -> [Window] -> ([Window], [Window])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
pm) ([Window] -> ([Window], [Window]))
-> [Window] -> ([Window], [Window])
forall a b. (a -> b) -> a -> b
$ [Window] -> [Window]
forall a. [a] -> [a]
reverse [Window]
r
        st' :: Stack Window
st'     = Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x [Window]
l' [Window]
r'
        b :: Bool
b       = [Window] -> Bool
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'  = ([Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
r) ([Window] -> [Window])
-> ([Window] -> [Window]) -> [Window] -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Window] -> [Window]
forall a. Int -> [a] -> [a]
cycleN Int
1 ([Window] -> [Window])
-> ([Window] -> [Window]) -> [Window] -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> [Window]
forall a. [a] -> [a]
reverse ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ [Window]
l
        st' :: Stack Window
st' = Window -> [Window] -> [Window] -> Stack Window
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 (Window -> Bool) -> [Window] -> ([Window], [Window])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Window -> Window -> Bool
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 [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ Window
x Window -> [Window] -> [Window]
forall a. a -> [a] -> [a]
: Int -> [Window] -> [Window]
forall a. Int -> [a] -> [a]
drop Int
1 [Window]
sr)
        st' :: Stack Window
st'     = Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x' [] [Window]
r'
        b :: Bool
b       = Window
x' Window -> Window -> Bool
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'  = [Window] -> [Window]
forall a. [a] -> [a]
init [Window]
l [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window
x]
        x' :: Window
x'  = [Window] -> Window
forall a. [a] -> a
last [Window]
l
        st' :: Stack Window
st' = Window -> [Window] -> [Window] -> Stack Window
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 :: Int -> [a] -> [a]
cycleN Int
n [a]
ls =
    let l :: Int
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls
    in  Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
l ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
l) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
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 :: (b -> Bool) -> [b] -> ([(a, b)], [b])
split b -> Bool
p [b]
l =
    let (a
_,[(a, b)]
ys,[b]
ns) = (b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
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' :: (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 ((a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
e)
            then (a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
1,(a, b)
e(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
ys,[(a, b)]
ns)
            else (a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
1,[(a, b)]
ys,(a, b)
e(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
ns)
        (a
c',[(a, b)]
ys',[(a, b)]
ns') = ((a, b) -> (a, [(a, b)], [(a, b)]) -> (a, [(a, b)], [(a, b)]))
-> (a, [(a, b)], [(a, b)]) -> [(a, b)] -> (a, [(a, b)], [(a, b)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a, b) -> (a, [(a, b)], [(a, b)]) -> (a, [(a, b)], [(a, b)])
forall a a.
Num a =>
(a, b) -> (a, [(a, b)], [(a, b)]) -> (a, [(a, b)], [(a, b)])
accumulate (a
0,[],[]) ([(a, b)] -> (a, [(a, b)], [(a, b)]))
-> [(a, b)] -> (a, [(a, b)], [(a, b)])
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
i..] [b]
l
    in  (a
c',[(a, b)]
ys',((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
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 :: [(a, b)] -> [b] -> [b]
merge [(a, b)]
il [b]
ul =
    let (a
_,[(a, b)]
il',[b]
ul') = a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
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' [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
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' :: 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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
i
    then let (a
x,[(a, b)]
y,[b]
z) = a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [(a, b)]
ps [b]
ul
         in  (a
x,[(a, b)]
y,b
ab -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
z)
    else let (a
x,[(a, b)]
y,[b]
z) = a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [(a, b)]
il [b]
bs
         in  (a
x,[(a, b)]
y,b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
z)
merge' a
i [] (b
b:[b]
bs) =
         let (a
x,[(a, b)]
y,[b]
z) = a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [] [b]
bs
         in  (a
x,[(a, b)]
y,b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
z)
merge' a
i il :: [(a, b)]
il@((a
j,b
a):[(a, b)]
ps) [] = if a
j a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
i
    then let (a
x,[(a, b)]
y,[b]
z) = a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [(a, b)]
ps []
         in  (a
x,[(a, b)]
y,b
ab -> [b] -> [b]
forall 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 :: 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) = (b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
forall a b.
(Num a, Enum a) =>
(b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
split' (b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set b
s) a
0 ([b] -> [b]
forall a. [a] -> [a]
reverse [b]
l)
        (a
_,[(a, b)]
fr,[b]
tr) = (b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
forall a b.
(Num a, Enum a) =>
(b -> Bool) -> a -> [b] -> (a, [(a, b)], [b])
split' (b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set b
s) (a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
1) [b]
r
    in  ([(a, b)]
fl[(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++[(a, b)]
fr,b -> [b] -> [b] -> Stack b
forall a. a -> [a] -> [a] -> Stack a
W.Stack b
x ([b] -> [b]
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 :: 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') = a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' a
0 [(a, b)]
il ([b] -> [b]
forall a. [a] -> [a]
reverse [b]
l)
        (a
_,[(a, b)]
il2,[b]
r') = a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
forall a b.
(Ord a, Num a) =>
a -> [(a, b)] -> [b] -> (a, [(a, b)], [b])
merge' (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [(a, b)]
il1 [b]
r
    in  b -> [b] -> [b] -> Stack b
forall a. a -> [a] -> [a] -> Stack a
W.Stack b
x ([b] -> [b]
forall a. [a] -> [a]
reverse [b]
l') ([b]
r' [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
il2)