{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
#ifdef TESTING
{-# OPTIONS_GHC -Wno-duplicate-exports #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.LimitWindows
-- Description :  A layout modifier that limits the number of windows that can be shown.
-- Copyright   :  (c) 2009 Adam Vogt
--                (c) 2009 Max Rabkin -- wrote limitSelect
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  vogt.adam@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout modifier that limits the number of windows that can be shown.
-- See "XMonad.Layout.Minimize" for manually setting hidden windows.
--
-----------------------------------------------------------------------------

module XMonad.Layout.LimitWindows (
    -- * Usage
    -- $usage

    -- * Layout Modifiers
    limitWindows,limitSlice,limitSelect,

    -- * Change the number of windows
    increaseLimit,decreaseLimit,setLimit,

#ifdef TESTING
    -- * For tests
    select,update,Selection(..),updateAndSelect,
#endif

    -- * Types
    LimitWindows, Selection,
    ) where

import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Prelude (fromJust, guard, (<=<))
import qualified XMonad.StackSet as W

-- $usage
-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.LimitWindows
--
-- > myLayout = limitWindows 6 $ Tall 1 0.03 0.5 ||| Full ||| RandomOtherLayout...
-- > main = xmonad def { layoutHook = myLayout }
--
-- You may also be interested in dynamically changing the number dynamically,
-- by binding keys to the 'increaseLimit', 'decreaseLimit', or 'setLimit'
-- actions.
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".
--
-- See also 'XMonad.Layout.BoringWindows.boringAuto' for keybindings that skip
-- the hidden windows.

increaseLimit :: X ()
increaseLimit :: X ()
increaseLimit = LimitChange -> X ()
forall a. Message a => a -> X ()
sendMessage (LimitChange -> X ()) -> LimitChange -> X ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> LimitChange
LimitChange Int -> Int
forall a. Enum a => a -> a
succ

decreaseLimit :: X ()
decreaseLimit :: X ()
decreaseLimit = LimitChange -> X ()
forall a. Message a => a -> X ()
sendMessage (LimitChange -> X ())
-> ((Int -> Int) -> LimitChange) -> (Int -> Int) -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> LimitChange
LimitChange ((Int -> Int) -> X ()) -> (Int -> Int) -> X ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred

setLimit :: Int -> X ()
setLimit :: Int -> X ()
setLimit Int
tgt = LimitChange -> X ()
forall a. Message a => a -> X ()
sendMessage (LimitChange -> X ())
-> ((Int -> Int) -> LimitChange) -> (Int -> Int) -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> LimitChange
LimitChange ((Int -> Int) -> X ()) -> (Int -> Int) -> X ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a b. a -> b -> a
const Int
tgt

-- | Only display the first @n@ windows.
limitWindows :: Int -> l a -> ModifiedLayout LimitWindows l a
limitWindows :: Int -> l a -> ModifiedLayout LimitWindows l a
limitWindows Int
n = LimitWindows a -> l a -> ModifiedLayout LimitWindows l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (SliceStyle -> Int -> LimitWindows a
forall a. SliceStyle -> Int -> LimitWindows a
LimitWindows SliceStyle
FirstN Int
n)

-- | Only display @n@ windows around the focused window. This makes sense with
-- layouts that arrange windows linearily, like 'XMonad.Layout.Layout.Accordion'.
limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a
limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a
limitSlice Int
n = LimitWindows a -> l a -> ModifiedLayout LimitWindows l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (SliceStyle -> Int -> LimitWindows a
forall a. SliceStyle -> Int -> LimitWindows a
LimitWindows SliceStyle
Slice Int
n)

-- | Only display the first @m@ windows and @r@ others.
-- The @IncMasterN@ message will change @m@, as well as passing it onto the
-- underlying layout.
limitSelect :: Int -> Int -> l a -> ModifiedLayout Selection l a
limitSelect :: Int -> Int -> l a -> ModifiedLayout Selection l a
limitSelect Int
m Int
r = Selection a -> l a -> ModifiedLayout Selection l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout Sel :: forall a. Int -> Int -> Int -> Selection a
Sel{ nMaster :: Int
nMaster=Int
m, start :: Int
start=Int
m, nRest :: Int
nRest=Int
r }

data LimitWindows a = LimitWindows SliceStyle Int deriving (ReadPrec [LimitWindows a]
ReadPrec (LimitWindows a)
Int -> ReadS (LimitWindows a)
ReadS [LimitWindows a]
(Int -> ReadS (LimitWindows a))
-> ReadS [LimitWindows a]
-> ReadPrec (LimitWindows a)
-> ReadPrec [LimitWindows a]
-> Read (LimitWindows a)
forall a. ReadPrec [LimitWindows a]
forall a. ReadPrec (LimitWindows a)
forall a. Int -> ReadS (LimitWindows a)
forall a. ReadS [LimitWindows a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LimitWindows a]
$creadListPrec :: forall a. ReadPrec [LimitWindows a]
readPrec :: ReadPrec (LimitWindows a)
$creadPrec :: forall a. ReadPrec (LimitWindows a)
readList :: ReadS [LimitWindows a]
$creadList :: forall a. ReadS [LimitWindows a]
readsPrec :: Int -> ReadS (LimitWindows a)
$creadsPrec :: forall a. Int -> ReadS (LimitWindows a)
Read,Int -> LimitWindows a -> ShowS
[LimitWindows a] -> ShowS
LimitWindows a -> String
(Int -> LimitWindows a -> ShowS)
-> (LimitWindows a -> String)
-> ([LimitWindows a] -> ShowS)
-> Show (LimitWindows a)
forall a. Int -> LimitWindows a -> ShowS
forall a. [LimitWindows a] -> ShowS
forall a. LimitWindows a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LimitWindows a] -> ShowS
$cshowList :: forall a. [LimitWindows a] -> ShowS
show :: LimitWindows a -> String
$cshow :: forall a. LimitWindows a -> String
showsPrec :: Int -> LimitWindows a -> ShowS
$cshowsPrec :: forall a. Int -> LimitWindows a -> ShowS
Show)

data SliceStyle = FirstN | Slice deriving (ReadPrec [SliceStyle]
ReadPrec SliceStyle
Int -> ReadS SliceStyle
ReadS [SliceStyle]
(Int -> ReadS SliceStyle)
-> ReadS [SliceStyle]
-> ReadPrec SliceStyle
-> ReadPrec [SliceStyle]
-> Read SliceStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SliceStyle]
$creadListPrec :: ReadPrec [SliceStyle]
readPrec :: ReadPrec SliceStyle
$creadPrec :: ReadPrec SliceStyle
readList :: ReadS [SliceStyle]
$creadList :: ReadS [SliceStyle]
readsPrec :: Int -> ReadS SliceStyle
$creadsPrec :: Int -> ReadS SliceStyle
Read,Int -> SliceStyle -> ShowS
[SliceStyle] -> ShowS
SliceStyle -> String
(Int -> SliceStyle -> ShowS)
-> (SliceStyle -> String)
-> ([SliceStyle] -> ShowS)
-> Show SliceStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SliceStyle] -> ShowS
$cshowList :: [SliceStyle] -> ShowS
show :: SliceStyle -> String
$cshow :: SliceStyle -> String
showsPrec :: Int -> SliceStyle -> ShowS
$cshowsPrec :: Int -> SliceStyle -> ShowS
Show)

newtype LimitChange = LimitChange { LimitChange -> Int -> Int
unLC :: Int -> Int }

instance Message LimitChange

instance LayoutModifier LimitWindows a where
     pureMess :: LimitWindows a -> SomeMessage -> Maybe (LimitWindows a)
pureMess (LimitWindows SliceStyle
s Int
n) =
        (Int -> LimitWindows a) -> Maybe Int -> Maybe (LimitWindows a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SliceStyle -> Int -> LimitWindows a
forall a. SliceStyle -> Int -> LimitWindows a
LimitWindows SliceStyle
s) (Maybe Int -> Maybe (LimitWindows a))
-> (Int -> Maybe Int) -> Int -> Maybe (LimitWindows a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall (m :: * -> *) b.
(Monad m, Alternative m, Ord b, Num b) =>
b -> m b
pos (Int -> Maybe (LimitWindows a))
-> (SomeMessage -> Maybe Int)
-> SomeMessage
-> Maybe (LimitWindows a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ((Int -> Int) -> Int -> Maybe Int
forall (m :: * -> *) b.
(Monad m, Alternative m, Eq b) =>
(b -> b) -> b -> m b
`app` Int
n) ((Int -> Int) -> Maybe Int)
-> (LimitChange -> Int -> Int) -> LimitChange -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LimitChange -> Int -> Int
unLC (LimitChange -> Maybe Int)
-> (SomeMessage -> Maybe LimitChange) -> SomeMessage -> Maybe Int
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< SomeMessage -> Maybe LimitChange
forall m. Message m => SomeMessage -> Maybe m
fromMessage
      where pos :: b -> m b
pos b
x   = Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (b
xb -> b -> Bool
forall a. Ord a => a -> a -> Bool
>=b
1)     m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
            app :: (b -> b) -> b -> m b
app b -> b
f b
x = Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (b -> b
f b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
x) m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b
f b
x)

     modifyLayout :: LimitWindows a
-> Workspace String (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
modifyLayout (LimitWindows SliceStyle
style Int
n) Workspace String (l a) a
ws =
        Workspace String (l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (l a) a
ws { stack :: Maybe (Stack a)
W.stack = Int -> Stack a -> Stack a
forall a. Int -> Stack a -> Stack a
f Int
n (Stack a -> Stack a) -> Maybe (Stack a) -> Maybe (Stack a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workspace String (l a) a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace String (l a) a
ws }
      where f :: Int -> Stack a -> Stack a
f = case SliceStyle
style of
                    SliceStyle
FirstN -> Int -> Stack a -> Stack a
forall a. Int -> Stack a -> Stack a
firstN
                    SliceStyle
Slice -> Int -> Stack a -> Stack a
forall a. Int -> Stack a -> Stack a
slice

firstN ::  Int -> W.Stack a -> W.Stack a
firstN :: Int -> Stack a -> Stack a
firstN Int
n Stack a
st = Stack a -> Stack a
forall a. Stack a -> Stack a
upfocus (Stack a -> Stack a) -> Stack a -> Stack a
forall a b. (a -> b) -> a -> b
$ Maybe (Stack a) -> Stack a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Stack a) -> Stack a) -> Maybe (Stack a) -> Stack a
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe (Stack a)
forall a. [a] -> Maybe (Stack a)
W.differentiate ([a] -> Maybe (Stack a)) -> [a] -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
st
    where upfocus :: Stack a -> Stack a
upfocus = ((Stack a -> Stack a)
 -> (Stack a -> Stack a) -> Stack a -> Stack a)
-> (Stack a -> Stack a)
-> [Stack a -> Stack a]
-> Stack a
-> Stack a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Stack a -> Stack a) -> (Stack a -> Stack a) -> Stack a -> Stack a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Stack a -> Stack a
forall a. a -> a
id ([Stack a -> Stack a] -> Stack a -> Stack a)
-> [Stack a -> Stack a] -> Stack a -> Stack a
forall a b. (a -> b) -> a -> b
$ Int -> (Stack a -> Stack a) -> [Stack a -> Stack a]
forall a. Int -> a -> [a]
replicate ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Stack a -> [a]
forall a. Stack a -> [a]
W.up Stack a
st)) Stack a -> Stack a
forall a. Stack a -> Stack a
W.focusDown'

-- | A non-wrapping, fixed-size slice of a stack around the focused element
slice ::  Int -> W.Stack t -> W.Stack t
slice :: Int -> Stack t -> Stack t
slice Int
n (W.Stack t
f [t]
u [t]
d) =
        t -> [t] -> [t] -> Stack t
forall a. a -> [a] -> [a] -> Stack a
W.Stack t
f (Int -> [t] -> [t]
forall a. Int -> [a] -> [a]
take (Int
nu Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
unusedD) [t]
u)
                  (Int -> [t] -> [t]
forall a. Int -> [a] -> [a]
take (Int
nd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
unusedU) [t]
d)
    where unusedD :: Int
unusedD = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
nd Int -> Int -> Int
forall a. Num a => a -> a -> a
- [t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t]
d
          unusedU :: Int
unusedU = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
nu Int -> Int -> Int
forall a. Num a => a -> a -> a
- [t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t]
u
          nd :: Int
nd = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
2
          nu :: Int
nu = (Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
2

data Selection a = Sel { Selection a -> Int
nMaster :: Int, Selection a -> Int
start :: Int, Selection a -> Int
nRest :: Int }
    deriving (ReadPrec [Selection a]
ReadPrec (Selection a)
Int -> ReadS (Selection a)
ReadS [Selection a]
(Int -> ReadS (Selection a))
-> ReadS [Selection a]
-> ReadPrec (Selection a)
-> ReadPrec [Selection a]
-> Read (Selection a)
forall a. ReadPrec [Selection a]
forall a. ReadPrec (Selection a)
forall a. Int -> ReadS (Selection a)
forall a. ReadS [Selection a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Selection a]
$creadListPrec :: forall a. ReadPrec [Selection a]
readPrec :: ReadPrec (Selection a)
$creadPrec :: forall a. ReadPrec (Selection a)
readList :: ReadS [Selection a]
$creadList :: forall a. ReadS [Selection a]
readsPrec :: Int -> ReadS (Selection a)
$creadsPrec :: forall a. Int -> ReadS (Selection a)
Read, Int -> Selection a -> ShowS
[Selection a] -> ShowS
Selection a -> String
(Int -> Selection a -> ShowS)
-> (Selection a -> String)
-> ([Selection a] -> ShowS)
-> Show (Selection a)
forall a. Int -> Selection a -> ShowS
forall a. [Selection a] -> ShowS
forall a. Selection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selection a] -> ShowS
$cshowList :: forall a. [Selection a] -> ShowS
show :: Selection a -> String
$cshow :: forall a. Selection a -> String
showsPrec :: Int -> Selection a -> ShowS
$cshowsPrec :: forall a. Int -> Selection a -> ShowS
Show, Selection a -> Selection a -> Bool
(Selection a -> Selection a -> Bool)
-> (Selection a -> Selection a -> Bool) -> Eq (Selection a)
forall a. Selection a -> Selection a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selection a -> Selection a -> Bool
$c/= :: forall a. Selection a -> Selection a -> Bool
== :: Selection a -> Selection a -> Bool
$c== :: forall a. Selection a -> Selection a -> Bool
Eq)

instance LayoutModifier Selection a where
    modifyLayout :: Selection a
-> Workspace String (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
modifyLayout Selection a
s Workspace String (l a) a
w =
        Workspace String (l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (Workspace String (l a) a
w { stack :: Maybe (Stack a)
W.stack = Selection a -> Stack a -> Stack a
forall l a. Selection l -> Stack a -> Stack a
updateAndSelect Selection a
s (Stack a -> Stack a) -> Maybe (Stack a) -> Maybe (Stack a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workspace String (l a) a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace String (l a) a
w })

    pureModifier :: Selection a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> ([(a, Rectangle)], Maybe (Selection a))
pureModifier Selection a
sel Rectangle
_ Maybe (Stack a)
stk [(a, Rectangle)]
wins = ([(a, Rectangle)]
wins, Selection a -> Stack a -> Selection a
forall l a. Selection l -> Stack a -> Selection a
update Selection a
sel (Stack a -> Selection a) -> Maybe (Stack a) -> Maybe (Selection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack a)
stk)

    pureMess :: Selection a -> SomeMessage -> Maybe (Selection a)
pureMess Selection a
sel SomeMessage
m
        | Just Int -> Int
f <- LimitChange -> Int -> Int
unLC (LimitChange -> Int -> Int)
-> Maybe LimitChange -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeMessage -> Maybe LimitChange
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Selection a -> Maybe (Selection a)
forall a. a -> Maybe a
Just (Selection a -> Maybe (Selection a))
-> Selection a -> Maybe (Selection a)
forall a b. (a -> b) -> a -> b
$ Selection a
sel { nRest :: Int
nRest = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int
f (Selection a -> Int
forall a. Selection a -> Int
nMaster Selection a
sel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Selection a -> Int
forall a. Selection a -> Int
nRest Selection a
sel) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Selection a -> Int
forall a. Selection a -> Int
nMaster Selection a
sel) }
        | Just (IncMasterN Int
n) <- SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Selection a -> Maybe (Selection a)
forall a. a -> Maybe a
Just (Selection a -> Maybe (Selection a))
-> Selection a -> Maybe (Selection a)
forall a b. (a -> b) -> a -> b
$ Selection a
sel { nMaster :: Int
nMaster = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Selection a -> Int
forall a. Selection a -> Int
nMaster Selection a
sel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) }
        | Bool
otherwise =
            Maybe (Selection a)
forall a. Maybe a
Nothing

select :: Selection l -> W.Stack a -> W.Stack a
select :: Selection l -> Stack a -> Stack a
select Selection l
s Stack a
stk
    | Int
lups Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Selection l -> Int
forall a. Selection a -> Int
nMaster Selection l
s
        = Stack a
stk { down :: [a]
W.down=Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Selection l -> Int
forall a. Selection a -> Int
nMaster Selection l
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lups Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
downs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++
                    (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Selection l -> Int
forall a. Selection a -> Int
nRest Selection l
s) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Selection l -> Int
forall a. Selection a -> Int
start Selection l
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lups Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
downs) }
    | Bool
otherwise
        = Stack a
stk { up :: [a]
W.up=[a] -> [a]
forall a. [a] -> [a]
reverse (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Selection l -> Int
forall a. Selection a -> Int
nMaster Selection l
s) [a]
ups [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Selection l -> Int
forall a. Selection a -> Int
start Selection l
s) [a]
ups),
                down :: [a]
W.down=Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Selection l -> Int
forall a. Selection a -> Int
nRest Selection l
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
lups Int -> Int -> Int
forall a. Num a => a -> a -> a
- Selection l -> Int
forall a. Selection a -> Int
start Selection l
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
downs }
    where
        downs :: [a]
downs = Stack a -> [a]
forall a. Stack a -> [a]
W.down Stack a
stk
        ups :: [a]
ups = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Stack a -> [a]
forall a. Stack a -> [a]
W.up Stack a
stk
        lups :: Int
lups = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ups

updateStart :: Selection l -> W.Stack a -> Int
updateStart :: Selection l -> Stack a -> Int
updateStart Selection l
s Stack a
stk
    | Int
lups Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Selection l -> Int
forall a. Selection a -> Int
nMaster Selection l
s  -- the focussed window is in the master pane
        = Selection l -> Int
forall a. Selection a -> Int
start Selection l
s Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` (Int
lups Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ldown Int -> Int -> Int
forall a. Num a => a -> a -> a
- Selection l -> Int
forall a. Selection a -> Int
nRest Selection l
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Selection l -> Int
forall a. Selection a -> Int
nMaster Selection l
s
    | Bool
otherwise
        = Selection l -> Int
forall a. Selection a -> Int
start Selection l
s Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
lups
                  Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` (Int
lups Int -> Int -> Int
forall a. Num a => a -> a -> a
- Selection l -> Int
forall a. Selection a -> Int
nRest Selection l
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                  Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` (Int
lups Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ldown Int -> Int -> Int
forall a. Num a => a -> a -> a
- Selection l -> Int
forall a. Selection a -> Int
nRest Selection l
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                  Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Selection l -> Int
forall a. Selection a -> Int
nMaster Selection l
s
    where
        lups :: Int
lups = [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.up Stack a
stk
        ldown :: Int
ldown = [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.down Stack a
stk

update :: Selection l -> W.Stack a -> Selection a
update :: Selection l -> Stack a -> Selection a
update Selection l
sel Stack a
stk = Selection l
sel { start :: Int
start=Selection l -> Stack a -> Int
forall l a. Selection l -> Stack a -> Int
updateStart Selection l
sel Stack a
stk }

updateAndSelect :: Selection l -> W.Stack a -> W.Stack a
updateAndSelect :: Selection l -> Stack a -> Stack a
updateAndSelect Selection l
sel Stack a
stk = Selection a -> Stack a -> Stack a
forall l a. Selection l -> Stack a -> Stack a
select (Selection l -> Stack a -> Selection a
forall l a. Selection l -> Stack a -> Selection a
update Selection l
sel Stack a
stk) Stack a
stk