{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.BoringWindows
-- Description :  Mark windows as boring.
-- Copyright   :  (c) 2008  David Roundy <droundy@darcs.net>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Adam Vogt <vogt.adam@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- BoringWindows is an extension to allow windows to be marked boring
--
-----------------------------------------------------------------------------

module XMonad.Layout.BoringWindows (
                                   -- * Usage
                                   -- $usage
                                   boringWindows, boringAuto,
                                   markBoring, markBoringEverywhere,
                                   clearBoring, focusUp, focusDown,
                                   focusMaster, swapUp, swapDown,
                                   siftUp, siftDown,

                                   UpdateBoring(UpdateBoring),
                                   BoringMessage(Replace,Merge),
                                   BoringWindows()

                                   -- * Tips
                                   -- ** variant of 'Full'
                                   -- $simplest
                                  ) where

import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
                                    LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))
import XMonad(LayoutClass, Message, X, fromMessage,
              broadcastMessage, sendMessage, windows, withFocused, Window)
import XMonad.Prelude
import XMonad.Util.Stack (reverseS)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import qualified XMonad.StackSet as W

-- $usage
-- You can use this module with the following in your
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.BoringWindows
--
-- Then edit your @layoutHook@ by adding the layout modifier:
--
-- > myLayout = boringWindows (Full ||| etc..)
-- > main = xmonad def { layoutHook = myLayout }
--
-- Then to your keybindings, add:
--
-- > , ((modm, xK_j), focusUp)
-- > , ((modm, xK_k), focusDown)
-- > , ((modm, xK_m), focusMaster)
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"


data BoringMessage = FocusUp | FocusDown | FocusMaster | IsBoring Window | ClearBoring
                     | Replace String [Window]
                     | Merge String [Window]
                     | SwapUp
                     | SwapDown
                     | SiftUp
                     | SiftDown
                     deriving ( ReadPrec [BoringMessage]
ReadPrec BoringMessage
Int -> ReadS BoringMessage
ReadS [BoringMessage]
(Int -> ReadS BoringMessage)
-> ReadS [BoringMessage]
-> ReadPrec BoringMessage
-> ReadPrec [BoringMessage]
-> Read BoringMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BoringMessage]
$creadListPrec :: ReadPrec [BoringMessage]
readPrec :: ReadPrec BoringMessage
$creadPrec :: ReadPrec BoringMessage
readList :: ReadS [BoringMessage]
$creadList :: ReadS [BoringMessage]
readsPrec :: Int -> ReadS BoringMessage
$creadsPrec :: Int -> ReadS BoringMessage
Read, Int -> BoringMessage -> ShowS
[BoringMessage] -> ShowS
BoringMessage -> String
(Int -> BoringMessage -> ShowS)
-> (BoringMessage -> String)
-> ([BoringMessage] -> ShowS)
-> Show BoringMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoringMessage] -> ShowS
$cshowList :: [BoringMessage] -> ShowS
show :: BoringMessage -> String
$cshow :: BoringMessage -> String
showsPrec :: Int -> BoringMessage -> ShowS
$cshowsPrec :: Int -> BoringMessage -> ShowS
Show )

instance Message BoringMessage

-- | UpdateBoring is sent before attempting to view another boring window, so
-- that layouts have a chance to mark boring windows.
data UpdateBoring = UpdateBoring
instance Message UpdateBoring

markBoring, clearBoring, focusUp, focusDown, focusMaster, swapUp, swapDown, siftUp, siftDown :: X ()
markBoring :: X ()
markBoring = (Window -> X ()) -> X ()
withFocused (BoringMessage -> X ()
forall a. Message a => a -> X ()
sendMessage (BoringMessage -> X ())
-> (Window -> BoringMessage) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> BoringMessage
IsBoring)
clearBoring :: X ()
clearBoring = BoringMessage -> X ()
forall a. Message a => a -> X ()
sendMessage BoringMessage
ClearBoring
focusUp :: X ()
focusUp = UpdateBoring -> X ()
forall a. Message a => a -> X ()
sendMessage UpdateBoring
UpdateBoring X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BoringMessage -> X ()
forall a. Message a => a -> X ()
sendMessage BoringMessage
FocusUp
focusDown :: X ()
focusDown = UpdateBoring -> X ()
forall a. Message a => a -> X ()
sendMessage UpdateBoring
UpdateBoring X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BoringMessage -> X ()
forall a. Message a => a -> X ()
sendMessage BoringMessage
FocusDown
focusMaster :: X ()
focusMaster = UpdateBoring -> X ()
forall a. Message a => a -> X ()
sendMessage UpdateBoring
UpdateBoring X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BoringMessage -> X ()
forall a. Message a => a -> X ()
sendMessage BoringMessage
FocusMaster
swapUp :: X ()
swapUp = UpdateBoring -> X ()
forall a. Message a => a -> X ()
sendMessage UpdateBoring
UpdateBoring X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BoringMessage -> X ()
forall a. Message a => a -> X ()
sendMessage BoringMessage
SwapUp
swapDown :: X ()
swapDown = UpdateBoring -> X ()
forall a. Message a => a -> X ()
sendMessage UpdateBoring
UpdateBoring X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BoringMessage -> X ()
forall a. Message a => a -> X ()
sendMessage BoringMessage
SwapDown
siftUp :: X ()
siftUp = UpdateBoring -> X ()
forall a. Message a => a -> X ()
sendMessage UpdateBoring
UpdateBoring X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BoringMessage -> X ()
forall a. Message a => a -> X ()
sendMessage BoringMessage
SiftUp
siftDown :: X ()
siftDown = UpdateBoring -> X ()
forall a. Message a => a -> X ()
sendMessage UpdateBoring
UpdateBoring X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BoringMessage -> X ()
forall a. Message a => a -> X ()
sendMessage BoringMessage
SiftDown

-- | Mark current focused window boring for all layouts.
-- This is useful in combination with the 'XMonad.Actions.CopyWindow' module.
markBoringEverywhere :: X ()
markBoringEverywhere :: X ()
markBoringEverywhere = (Window -> X ()) -> X ()
withFocused (BoringMessage -> X ()
forall a. Message a => a -> X ()
broadcastMessage (BoringMessage -> X ())
-> (Window -> BoringMessage) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> BoringMessage
IsBoring)

data BoringWindows a = BoringWindows
    { forall a. BoringWindows a -> Map String [a]
namedBoring :: M.Map String [a] -- ^ store borings with a specific source
    , forall a. BoringWindows a -> [a]
chosenBoring :: [a]             -- ^ user-chosen borings
    , forall a. BoringWindows a -> Maybe [a]
hiddenBoring :: Maybe [a]       -- ^ maybe mark hidden windows
    } deriving (Int -> BoringWindows a -> ShowS
[BoringWindows a] -> ShowS
BoringWindows a -> String
(Int -> BoringWindows a -> ShowS)
-> (BoringWindows a -> String)
-> ([BoringWindows a] -> ShowS)
-> Show (BoringWindows a)
forall a. Show a => Int -> BoringWindows a -> ShowS
forall a. Show a => [BoringWindows a] -> ShowS
forall a. Show a => BoringWindows a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoringWindows a] -> ShowS
$cshowList :: forall a. Show a => [BoringWindows a] -> ShowS
show :: BoringWindows a -> String
$cshow :: forall a. Show a => BoringWindows a -> String
showsPrec :: Int -> BoringWindows a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BoringWindows a -> ShowS
Show,ReadPrec [BoringWindows a]
ReadPrec (BoringWindows a)
Int -> ReadS (BoringWindows a)
ReadS [BoringWindows a]
(Int -> ReadS (BoringWindows a))
-> ReadS [BoringWindows a]
-> ReadPrec (BoringWindows a)
-> ReadPrec [BoringWindows a]
-> Read (BoringWindows a)
forall a. Read a => ReadPrec [BoringWindows a]
forall a. Read a => ReadPrec (BoringWindows a)
forall a. Read a => Int -> ReadS (BoringWindows a)
forall a. Read a => ReadS [BoringWindows a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BoringWindows a]
$creadListPrec :: forall a. Read a => ReadPrec [BoringWindows a]
readPrec :: ReadPrec (BoringWindows a)
$creadPrec :: forall a. Read a => ReadPrec (BoringWindows a)
readList :: ReadS [BoringWindows a]
$creadList :: forall a. Read a => ReadS [BoringWindows a]
readsPrec :: Int -> ReadS (BoringWindows a)
$creadsPrec :: forall a. Read a => Int -> ReadS (BoringWindows a)
Read)

boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
boringWindows :: forall (l :: * -> *) a.
(LayoutClass l a, Eq a) =>
l a -> ModifiedLayout BoringWindows l a
boringWindows = BoringWindows a -> l a -> ModifiedLayout BoringWindows l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Map String [a] -> [a] -> Maybe [a] -> BoringWindows a
forall a. Map String [a] -> [a] -> Maybe [a] -> BoringWindows a
BoringWindows Map String [a]
forall k a. Map k a
M.empty [] Maybe [a]
forall a. Maybe a
Nothing)

-- | Mark windows that are not given rectangles as boring
boringAuto :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
boringAuto :: forall (l :: * -> *) a.
(LayoutClass l a, Eq a) =>
l a -> ModifiedLayout BoringWindows l a
boringAuto = BoringWindows a -> l a -> ModifiedLayout BoringWindows l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Map String [a] -> [a] -> Maybe [a] -> BoringWindows a
forall a. Map String [a] -> [a] -> Maybe [a] -> BoringWindows a
BoringWindows Map String [a]
forall k a. Map k a
M.empty [] ([a] -> Maybe [a]
forall a. a -> Maybe a
Just []))

instance LayoutModifier BoringWindows Window where
    redoLayout :: BoringWindows Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe (BoringWindows Window))
redoLayout b :: BoringWindows Window
b@BoringWindows{ hiddenBoring :: forall a. BoringWindows a -> Maybe [a]
hiddenBoring = Maybe [Window]
bs } Rectangle
_r Maybe (Stack Window)
mst [(Window, Rectangle)]
arrs = do
        let bs' :: [Window]
bs' = Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack Window)
mst [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
\\ ((Window, Rectangle) -> Window)
-> [(Window, Rectangle)] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst [(Window, Rectangle)]
arrs
        ([(Window, Rectangle)], Maybe (BoringWindows Window))
-> X ([(Window, Rectangle)], Maybe (BoringWindows Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
arrs, BoringWindows Window -> Maybe (BoringWindows Window)
forall a. a -> Maybe a
Just (BoringWindows Window -> Maybe (BoringWindows Window))
-> BoringWindows Window -> Maybe (BoringWindows Window)
forall a b. (a -> b) -> a -> b
$ BoringWindows Window
b { hiddenBoring :: Maybe [Window]
hiddenBoring = [Window]
bs' [Window] -> Maybe [Window] -> Maybe [Window]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe [Window]
bs } )

    handleMessOrMaybeModifyIt :: BoringWindows Window
-> SomeMessage
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
handleMessOrMaybeModifyIt bst :: BoringWindows Window
bst@(BoringWindows Map String [Window]
nbs [Window]
cbs Maybe [Window]
lbs) SomeMessage
m
        | Just (Replace String
k [Window]
ws) <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
        , [Window] -> Maybe [Window]
forall a. a -> Maybe a
Just [Window]
ws Maybe [Window] -> Maybe [Window] -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Map String [Window] -> Maybe [Window]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String [Window]
nbs =
            let nnb :: Map String [Window]
nnb = if [Window] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Window]
ws then String -> Map String [Window] -> Map String [Window]
forall k a. Ord k => k -> Map k a -> Map k a
M.delete String
k Map String [Window]
nbs
                          else String -> [Window] -> Map String [Window] -> Map String [Window]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
k [Window]
ws Map String [Window]
nbs
            in BoringWindows Window
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall {a} {b}. a -> X (Maybe (Either a b))
rjl BoringWindows Window
bst { namedBoring :: Map String [Window]
namedBoring = Map String [Window]
nnb }
        | Just (Merge String
k [Window]
ws) <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
        , Bool -> ([Window] -> Bool) -> Maybe [Window] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not (Bool -> Bool) -> ([Window] -> Bool) -> [Window] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Window] -> Bool) -> ([Window] -> [Window]) -> [Window] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Window]
ws [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
\\)) (String -> Map String [Window] -> Maybe [Window]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String [Window]
nbs) =
            BoringWindows Window
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall {a} {b}. a -> X (Maybe (Either a b))
rjl BoringWindows Window
bst { namedBoring :: Map String [Window]
namedBoring = ([Window] -> [Window] -> [Window])
-> String -> [Window] -> Map String [Window] -> Map String [Window]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
union String
k [Window]
ws Map String [Window]
nbs }
        | Just (IsBoring Window
w) <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m , Window
w Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
cbs =
            BoringWindows Window
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall {a} {b}. a -> X (Maybe (Either a b))
rjl BoringWindows Window
bst { chosenBoring :: [Window]
chosenBoring = Window
wWindow -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:[Window]
cbs }
        | Just BoringMessage
ClearBoring <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m, Bool -> Bool
not ([Window] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Window]
cbs) =
            BoringWindows Window
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall {a} {b}. a -> X (Maybe (Either a b))
rjl BoringWindows Window
bst { namedBoring :: Map String [Window]
namedBoring = Map String [Window]
forall k a. Map k a
M.empty, chosenBoring :: [Window]
chosenBoring = []}
        | Just BoringMessage
FocusUp <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
                            do (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
W.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
-> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> Stack Window -> Stack Window
skipBoring Stack Window -> Stack Window
forall a. Stack a -> Stack a
W.focusUp'
                               Maybe (Either (BoringWindows Window) SomeMessage)
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (BoringWindows Window) SomeMessage)
forall a. Maybe a
Nothing
        | Just BoringMessage
FocusDown <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
                            do (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
W.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
-> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> Stack Window -> Stack Window
skipBoring Stack Window -> Stack Window
forall a. Stack a -> Stack a
W.focusDown'
                               Maybe (Either (BoringWindows Window) SomeMessage)
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (BoringWindows Window) SomeMessage)
forall a. Maybe a
Nothing
        | Just BoringMessage
FocusMaster <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
                            do (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
W.modify'
                                            ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
-> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> Stack Window -> Stack Window
skipBoring Stack Window -> Stack Window
forall a. Stack a -> Stack a
W.focusDown' -- wiggle focus to make sure
                                            (Stack Window -> Stack Window)
-> (Stack Window -> Stack Window) -> Stack Window -> Stack Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack Window -> Stack Window) -> Stack Window -> Stack Window
skipBoring Stack Window -> Stack Window
forall a. Stack a -> Stack a
W.focusUp'   -- no boring window gets the focus
                                            (Stack Window -> Stack Window)
-> (Stack Window -> Stack Window) -> Stack Window -> Stack Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Stack Window
forall a. Stack a -> Stack a
focusMaster'
                               Maybe (Either (BoringWindows Window) SomeMessage)
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (BoringWindows Window) SomeMessage)
forall a. Maybe a
Nothing
        | Just BoringMessage
SwapUp <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
                            do (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
W.modify' Stack Window -> Stack Window
skipBoringSwapUp
                               Maybe (Either (BoringWindows Window) SomeMessage)
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (BoringWindows Window) SomeMessage)
forall a. Maybe a
Nothing
        | Just BoringMessage
SwapDown <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
                            do (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
W.modify' (Stack Window -> Stack Window
forall a. Stack a -> Stack a
reverseS (Stack Window -> Stack Window)
-> (Stack Window -> Stack Window) -> Stack Window -> Stack Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Stack Window
skipBoringSwapUp (Stack Window -> Stack Window)
-> (Stack Window -> Stack Window) -> Stack Window -> Stack Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Stack Window
forall a. Stack a -> Stack a
reverseS)
                               Maybe (Either (BoringWindows Window) SomeMessage)
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (BoringWindows Window) SomeMessage)
forall a. Maybe a
Nothing
        | Just BoringMessage
SiftUp <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
                            do (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
W.modify' ([Window] -> Stack Window -> Stack Window
forall a. Eq a => [a] -> Stack a -> Stack a
siftUpSkipping [Window]
bs)
                               Maybe (Either (BoringWindows Window) SomeMessage)
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (BoringWindows Window) SomeMessage)
forall a. Maybe a
Nothing
        | Just BoringMessage
SiftDown <- SomeMessage -> Maybe BoringMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
                            do (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
W.modify' (Stack Window -> Stack Window
forall a. Stack a -> Stack a
reverseS (Stack Window -> Stack Window)
-> (Stack Window -> Stack Window) -> Stack Window -> Stack Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> Stack Window -> Stack Window
forall a. Eq a => [a] -> Stack a -> Stack a
siftUpSkipping [Window]
bs (Stack Window -> Stack Window)
-> (Stack Window -> Stack Window) -> Stack Window -> Stack Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Stack Window
forall a. Stack a -> Stack a
reverseS)
                               Maybe (Either (BoringWindows Window) SomeMessage)
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (BoringWindows Window) SomeMessage)
forall a. Maybe a
Nothing
        where skipBoring :: (Stack Window -> Stack Window) -> Stack Window -> Stack Window
skipBoring = (Stack Window -> Bool)
-> (Stack Window -> Stack Window) -> Stack Window -> Stack Window
forall {a}.
(Stack a -> Bool) -> (Stack a -> Stack a) -> Stack a -> Stack a
skipBoring' ((Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
bs) (Window -> Bool)
-> (Stack Window -> Window) -> Stack Window -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Window
forall a. Stack a -> a
W.focus)
              skipBoringSwapUp :: Stack Window -> Stack Window
skipBoringSwapUp = (Stack Window -> Bool)
-> (Stack Window -> Stack Window) -> Stack Window -> Stack Window
forall {a}.
(Stack a -> Bool) -> (Stack a -> Stack a) -> Stack a -> Stack a
skipBoring'
                                   (Bool -> (Window -> Bool) -> Maybe Window -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
bs) (Maybe Window -> Bool)
-> (Stack Window -> Maybe Window) -> Stack Window -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> Maybe Window
forall a. [a] -> Maybe a
listToMaybe ([Window] -> Maybe Window)
-> (Stack Window -> [Window]) -> Stack Window -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> [Window]
forall a. Stack a -> [a]
W.down)
                                   Stack Window -> Stack Window
forall a. Stack a -> Stack a
swapUp'
              skipBoring' :: (Stack a -> Bool) -> (Stack a -> Stack a) -> Stack a -> Stack a
skipBoring' Stack a -> Bool
p Stack a -> Stack a
f Stack a
st = Stack a -> Maybe (Stack a) -> Stack a
forall a. a -> Maybe a -> a
fromMaybe Stack a
st
                                   (Maybe (Stack a) -> Stack a) -> Maybe (Stack a) -> Stack a
forall a b. (a -> b) -> a -> b
$ (Stack a -> Bool) -> [Stack a] -> Maybe (Stack a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Stack a -> Bool
p
                                   ([Stack a] -> Maybe (Stack a)) -> [Stack a] -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ Int -> [Stack a] -> [Stack a]
forall a. Int -> [a] -> [a]
drop Int
1
                                   ([Stack a] -> [Stack a]) -> [Stack a] -> [Stack a]
forall a b. (a -> b) -> a -> b
$ Int -> [Stack a] -> [Stack a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
st)
                                   ([Stack a] -> [Stack a]) -> [Stack a] -> [Stack a]
forall a b. (a -> b) -> a -> b
$ (Stack a -> Stack a) -> Stack a -> [Stack a]
forall a. (a -> a) -> a -> [a]
iterate Stack a -> Stack a
f Stack a
st
              bs :: [Window]
bs = [[Window]] -> [Window]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Window]] -> [Window]) -> [[Window]] -> [Window]
forall a b. (a -> b) -> a -> b
$ [Window]
cbs[Window] -> [[Window]] -> [[Window]]
forall a. a -> [a] -> [a]
:Maybe [Window] -> [[Window]]
forall a. Maybe a -> [a]
maybeToList Maybe [Window]
lbs [[Window]] -> [[Window]] -> [[Window]]
forall a. [a] -> [a] -> [a]
++ Map String [Window] -> [[Window]]
forall k a. Map k a -> [a]
M.elems Map String [Window]
nbs
              rjl :: a -> X (Maybe (Either a b))
rjl = Maybe (Either a b) -> X (Maybe (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either a b) -> X (Maybe (Either a b)))
-> (a -> Maybe (Either a b)) -> a -> X (Maybe (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (Either a b -> Maybe (Either a b))
-> (a -> Either a b) -> a -> Maybe (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left
    handleMessOrMaybeModifyIt BoringWindows Window
_ SomeMessage
_ = Maybe (Either (BoringWindows Window) SomeMessage)
-> X (Maybe (Either (BoringWindows Window) SomeMessage))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (BoringWindows Window) SomeMessage)
forall a. Maybe a
Nothing

-- | Variant of 'focusMaster' that works on a
-- 'Stack' rather than an entire 'StackSet'.
focusMaster' :: W.Stack a -> W.Stack a
focusMaster' :: forall a. Stack a -> Stack a
focusMaster' c :: Stack a
c@(W.Stack a
_ [] [a]
_) = Stack a
c
focusMaster' (W.Stack a
t (a
l:[a]
ls) [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
x [] ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
t a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs) where (a
x :| [a]
xs) = NonEmpty a -> NonEmpty a
forall a. NonEmpty a -> NonEmpty a
NE.reverse (a
l a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
ls)

swapUp' :: W.Stack a -> W.Stack a
swapUp' :: forall a. Stack a -> Stack a
swapUp' (W.Stack a
t (a
l:[a]
ls) [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t [a]
ls (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)
swapUp' (W.Stack a
t []     [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rs) []

siftUpSkipping :: Eq a => [a] -> W.Stack a -> W.Stack a
siftUpSkipping :: forall a. Eq a => [a] -> Stack a -> Stack a
siftUpSkipping [a]
bs (W.Stack a
t [a]
ls [a]
rs)
  | ([a]
skips, a
l:[a]
ls') <- ([a], [a])
spanLeft  = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t [a]
ls' ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
skips [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
l a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs)
  | ([a]
skips, a
r:[a]
rs') <- ([a], [a])
spanRight = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t ([a]
rs' [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ls) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
skips)
  | Bool
otherwise                   = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t [a]
ls [a]
rs
  where
    spanLeft :: ([a], [a])
spanLeft  = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
bs) [a]
ls
    spanRight :: ([a], [a])
spanRight = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
bs) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rs)

{- $simplest

An alternative to 'Full' is "XMonad.Layout.Simplest".  Less windows are
ignored by 'focusUp' and 'focusDown'. This may be helpful when you want windows
to be uninteresting by some other layout modifier (ex.
"XMonad.Layout.Minimize")

-}