{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module XMonad.Layout.SubLayouts (
subLayout,
subTabbed,
pushGroup, pullGroup,
pushWindow, pullWindow,
onGroup, toSubl, mergeDir,
GroupMsg(..),
Broadcast(..),
defaultSublMap,
Sublayout,
)
where
import XMonad.Layout.Decoration(Decoration, DefaultShrinker)
import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout,
redoLayout),
ModifiedLayout(..))
import XMonad.Layout.Simplest(Simplest(..))
import XMonad.Layout.Tabbed(shrinkText,
TabbedDecoration, addTabs)
import XMonad.Layout.WindowNavigation(Navigate(Apply))
import XMonad.Util.Invisible(Invisible(..))
import XMonad.Util.Types(Direction2D(..))
import XMonad hiding (def)
import XMonad.Prelude
import Control.Arrow(Arrow(second, (&&&)))
import qualified XMonad as X
import qualified XMonad.Layout.BoringWindows as B
import qualified XMonad.StackSet as W
import qualified Data.Map as M
import Data.Map(Map)
import qualified Data.Set as S
subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a
subLayout :: forall (subl :: * -> *) a (l :: * -> *).
[Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a
subLayout [Int]
nextLayout subl a
sl = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout (forall (m :: * -> *) a. m a -> Invisible m a
I []) ([Int]
nextLayout,subl a
sl) [])
subTabbed :: (Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) =>
l a -> ModifiedLayout (Decoration TabbedDecoration DefaultShrinker)
(ModifiedLayout (Sublayout Simplest) l) a
subTabbed :: forall a (l :: * -> *).
(Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) =>
l a
-> ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker)
(ModifiedLayout (Sublayout Simplest) l)
a
subTabbed l a
x = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabs DefaultShrinker
shrinkText forall a. Default a => a
X.def forall a b. (a -> b) -> a -> b
$ forall (subl :: * -> *) a (l :: * -> *).
[Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a
subLayout [] forall a. Simplest a
Simplest l a
x
defaultSublMap :: XConfig l -> Map (KeyMask, KeySym) (X ())
defaultSublMap :: forall (l :: * -> *). XConfig l -> Map (KeyMask, Window) (X ())
defaultSublMap XConfig{ modMask :: forall (l :: * -> *). XConfig l -> KeyMask
modMask = KeyMask
modm } = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[((KeyMask
modm, Window
xK_space), forall a. Message a => a -> X ()
toSubl ChangeLayout
NextLayout),
((KeyMask
modm, Window
xK_j), (Stack Window -> Stack Window) -> X ()
onGroup forall a. Stack a -> Stack a
W.focusDown'),
((KeyMask
modm, Window
xK_k), (Stack Window -> Stack Window) -> X ()
onGroup forall a. Stack a -> Stack a
W.focusUp'),
((KeyMask
modm, Window
xK_h), forall a. Message a => a -> X ()
toSubl Resize
Shrink),
((KeyMask
modm, Window
xK_l), forall a. Message a => a -> X ()
toSubl Resize
Expand),
((KeyMask
modm, Window
xK_Tab), (Stack Window -> Stack Window) -> X ()
onGroup forall a. Stack a -> Stack a
W.focusDown'),
((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_Tab), (Stack Window -> Stack Window) -> X ()
onGroup forall a. Stack a -> Stack a
W.focusUp'),
((KeyMask
modm, Window
xK_m), (Stack Window -> Stack Window) -> X ()
onGroup forall a. Stack a -> Stack a
focusMaster'),
((KeyMask
modm, Window
xK_comma), forall a. Message a => a -> X ()
toSubl forall a b. (a -> b) -> a -> b
$ Int -> IncMasterN
IncMasterN Int
1),
((KeyMask
modm, Window
xK_period), forall a. Message a => a -> X ()
toSubl forall a b. (a -> b) -> a -> b
$ Int -> IncMasterN
IncMasterN (-Int
1)),
((KeyMask
modm, Window
xK_Return), (Stack Window -> Stack Window) -> X ()
onGroup forall a. Stack a -> Stack a
swapMaster')
]
where
focusMaster' :: Stack a -> Stack a
focusMaster' Stack a
st = let (forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> a
f :| [a]
fs) = forall a. Stack a -> [a]
W.integrate Stack a
st
in forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [] [a]
fs
swapMaster' :: Stack a -> Stack a
swapMaster' (W.Stack a
f [a]
u [a]
d) = forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [] forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [a]
u forall a. [a] -> [a] -> [a]
++ [a]
d
data Sublayout l a = Sublayout
{ forall (l :: * -> *) a.
Sublayout l a -> Invisible [] (SomeMessage, a)
delayMess :: Invisible [] (SomeMessage,a)
, forall (l :: * -> *) a. Sublayout l a -> ([Int], l a)
def :: ([Int], l a)
, forall (l :: * -> *) a. Sublayout l a -> [(l a, Stack a)]
subls :: [(l a,W.Stack a)]
}
deriving (ReadPrec [Sublayout l a]
ReadPrec (Sublayout l a)
ReadS [Sublayout l a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec [Sublayout l a]
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec (Sublayout l a)
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
Int -> ReadS (Sublayout l a)
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadS [Sublayout l a]
readListPrec :: ReadPrec [Sublayout l a]
$creadListPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec [Sublayout l a]
readPrec :: ReadPrec (Sublayout l a)
$creadPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec (Sublayout l a)
readList :: ReadS [Sublayout l a]
$creadList :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadS [Sublayout l a]
readsPrec :: Int -> ReadS (Sublayout l a)
$creadsPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
Int -> ReadS (Sublayout l a)
Read,Int -> Sublayout l a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Int -> Sublayout l a -> ShowS
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
[Sublayout l a] -> ShowS
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Sublayout l a -> String
showList :: [Sublayout l a] -> ShowS
$cshowList :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
[Sublayout l a] -> ShowS
show :: Sublayout l a -> String
$cshow :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Sublayout l a -> String
showsPrec :: Int -> Sublayout l a -> ShowS
$cshowsPrec :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Int -> Sublayout l a -> ShowS
Show)
type Groups a = Map a (W.Stack a)
type GroupStack a = W.Stack (W.Stack a)
data GroupMsg a
= UnMerge a
| UnMergeAll a
| Merge a a
| MergeAll a
| Migrate a a
| WithGroup (W.Stack a -> X (W.Stack a)) a
| SubMessage SomeMessage a
mergeDir :: (W.Stack Window -> W.Stack Window) -> Window -> GroupMsg Window
mergeDir :: (Stack Window -> Stack Window) -> Window -> GroupMsg Window
mergeDir Stack Window -> Stack Window
f = forall a. (Stack a -> X (Stack a)) -> a -> GroupMsg a
WithGroup Stack Window -> X (Stack Window)
g
where g :: Stack Window -> X (Stack Window)
g Stack Window
cs = do
let onlyOthers :: Stack Window -> Maybe (Stack Window)
onlyOthers = forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. Stack a -> [a]
W.integrate Stack Window
cs)
(forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
`whenJust` forall a. Message a => a -> X ()
sendMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a -> GroupMsg a
Merge (forall a. Stack a -> a
W.focus Stack Window
cs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> a
W.focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Stack Window
f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack Window -> Maybe (Stack Window)
onlyOthers forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X (Maybe (Stack Window))
currentStack
forall (m :: * -> *) a. Monad m => a -> m a
return Stack Window
cs
newtype Broadcast = Broadcast SomeMessage
instance Message Broadcast
instance Typeable a => Message (GroupMsg a)
pullGroup,pushGroup,pullWindow,pushWindow :: Direction2D -> Navigate
pullGroup :: Direction2D -> Navigate
pullGroup = (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav (\Window
o Window
c -> forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> GroupMsg a
Merge Window
o Window
c)
pushGroup :: Direction2D -> Navigate
pushGroup = (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav (\Window
o Window
c -> forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> GroupMsg a
Merge Window
c Window
o)
pullWindow :: Direction2D -> Navigate
pullWindow = (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav (\Window
o Window
c -> forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> GroupMsg a
Migrate Window
o Window
c)
pushWindow :: Direction2D -> Navigate
pushWindow = (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav (\Window
o Window
c -> forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> GroupMsg a
Migrate Window
c Window
o)
mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav Window -> Window -> X ()
f = (Window -> X ()) -> Direction2D -> Navigate
Apply ((Window -> X ()) -> X ()
withFocused forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Window -> X ()
f)
onGroup :: (W.Stack Window -> W.Stack Window) -> X ()
onGroup :: (Stack Window -> Stack Window) -> X ()
onGroup Stack Window -> Stack Window
f = (Window -> X ()) -> X ()
withFocused (forall a. Message a => a -> X ()
sendMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Stack a -> X (Stack a)) -> a -> GroupMsg a
WithGroup (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Stack Window
f))
toSubl :: (Message a) => a -> X ()
toSubl :: forall a. Message a => a -> X ()
toSubl a
m = (Window -> X ()) -> X ()
withFocused (forall a. Message a => a -> X ()
sendMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SomeMessage -> a -> GroupMsg a
SubMessage (forall a. Message a => a -> SomeMessage
SomeMessage a
m))
instance forall l. (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where
modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
Sublayout l Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout Sublayout{ subls :: forall (l :: * -> *) a. Sublayout l a -> [(l a, Stack a)]
subls = [(l Window, Stack Window)]
osls } (W.Workspace String
i l Window
la Maybe (Stack Window)
st) Rectangle
r = do
let gs' :: Groups Window
gs' = forall a. Ord a => Maybe (Stack a) -> Groups a -> Groups a
updateGroup Maybe (Stack Window)
st forall a b. (a -> b) -> a -> b
$ forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(l Window, Stack Window)]
osls
st' :: Maybe (Stack Window)
st' = forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall k a. Map k a -> [k]
M.keys Groups Window
gs') forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Stack Window)
st
Groups Window -> X ()
updateWs Groups Window
gs'
Maybe (Stack Window)
oldStack <- X (Maybe (Stack Window))
currentStack
Maybe (Stack Window) -> X ()
setStack Maybe (Stack Window)
st'
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
i l Window
la Maybe (Stack Window)
st') Rectangle
r forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Maybe (Stack Window) -> X ()
setStack Maybe (Stack Window)
oldStack
redoLayout :: Sublayout l Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe (Sublayout l Window))
redoLayout Sublayout{ delayMess :: forall (l :: * -> *) a.
Sublayout l a -> Invisible [] (SomeMessage, a)
delayMess = I [(SomeMessage, Window)]
ms, def :: forall (l :: * -> *) a. Sublayout l a -> ([Int], l a)
def = ([Int], l Window)
defl, subls :: forall (l :: * -> *) a. Sublayout l a -> [(l a, Stack a)]
subls = [(l Window, Stack Window)]
osls } Rectangle
_r Maybe (Stack Window)
st [(Window, Rectangle)]
arrs = do
let gs' :: Groups Window
gs' = forall a. Ord a => Maybe (Stack a) -> Groups a -> Groups a
updateGroup Maybe (Stack Window)
st forall a b. (a -> b) -> a -> b
$ forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(l Window, Stack Window)]
osls
[(Bool, (l Window, Stack Window))]
sls <- forall (layout :: * -> *) a k b.
(LayoutClass layout a, Ord k) =>
([Int], layout a)
-> Maybe (Stack k)
-> Groups k
-> [(layout a, b)]
-> X [(Bool, (layout a, Stack k))]
fromGroups ([Int], l Window)
defl Maybe (Stack Window)
st Groups Window
gs' [(l Window, Stack Window)]
osls
let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> l Window -> Bool
-> Maybe (W.Stack Window) -> X ([(Window, Rectangle)], l Window)
newL :: LayoutClass l Window =>
Rectangle
-> String
-> l Window
-> Bool
-> Maybe (Stack Window)
-> X ([(Window, Rectangle)], l Window)
newL Rectangle
rect String
n l Window
ol Bool
isNew Maybe (Stack Window)
sst = do
Maybe (Stack Window)
orgStack <- X (Maybe (Stack Window))
currentStack
let handle :: layout a -> (SomeMessage, b) -> X (layout a)
handle layout a
l (SomeMessage
y,b
_)
| Bool -> Bool
not Bool
isNew = forall a. a -> Maybe a -> a
fromMaybe layout a
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage layout a
l SomeMessage
y
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return layout a
l
kms :: [(SomeMessage, Window)]
kms = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall k a. Map k a -> [k]
M.keys Groups Window
gs') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(SomeMessage, Window)]
ms
Maybe (Stack Window) -> X ()
setStack Maybe (Stack Window)
sst
l Window
nl <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {layout :: * -> *} {a} {b}.
LayoutClass layout a =>
layout a -> (SomeMessage, b) -> X (layout a)
handle l Window
ol forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack Window)
sst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(SomeMessage, Window)]
kms
([(Window, Rectangle)], Maybe (l Window))
result <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
n l Window
nl Maybe (Stack Window)
sst) Rectangle
rect
Maybe (Stack Window) -> X ()
setStack Maybe (Stack Window)
orgStack
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe l Window
nl forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
`second` ([(Window, Rectangle)], Maybe (l Window))
result
([X ([(Window, Rectangle)], l Window)]
urls,[Maybe (Stack Window)]
ssts) = forall a b. [(a, b)] -> ([a], [b])
unzip [ (LayoutClass l Window =>
Rectangle
-> String
-> l Window
-> Bool
-> Maybe (Stack Window)
-> X ([(Window, Rectangle)], l Window)
newL Rectangle
gr String
i l Window
l Bool
isNew Maybe (Stack Window)
sst, Maybe (Stack Window)
sst)
| (Bool
isNew,(l Window
l,Stack Window
_st)) <- [(Bool, (l Window, Stack Window))]
sls
| String
i <- forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [ Int
0 :: Int .. ]
| (Window
k,Rectangle
gr) <- [(Window, Rectangle)]
arrs, let sst :: Maybe (Stack Window)
sst = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
k Groups Window
gs' ]
[([(Window, Rectangle)], l Window)]
arrs' <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [X ([(Window, Rectangle)], l Window)]
urls
Maybe (Sublayout l Window)
sls' <- forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout (forall (m :: * -> *) a. m a -> Invisible m a
I []) ([Int], l Window)
defl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a k b.
(LayoutClass layout a, Ord k) =>
([Int], layout a)
-> Maybe (Stack k)
-> Groups k
-> [(layout a, b)]
-> X [(Bool, (layout a, Stack k))]
fromGroups ([Int], l Window)
defl Maybe (Stack Window)
st Groups Window
gs'
[ (l Window
l,Stack Window
s) | ([(Window, Rectangle)]
_,l Window
l) <- [([(Window, Rectangle)], l Window)]
arrs' | (Just Stack Window
s) <- [Maybe (Stack Window)]
ssts ]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> a
fst [([(Window, Rectangle)], l Window)]
arrs', Maybe (Sublayout l Window)
sls')
handleMess :: Sublayout l Window -> SomeMessage -> X (Maybe (Sublayout l Window))
handleMess (Sublayout (I [(SomeMessage, Window)]
ms) ([Int], l Window)
defl [(l Window, Stack Window)]
sls) SomeMessage
m
| Just (SubMessage SomeMessage
sm Window
w) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout (forall (m :: * -> *) a. m a -> Invisible m a
I ((SomeMessage
sm,Window
w)forall a. a -> [a] -> [a]
:[(SomeMessage, Window)]
ms)) ([Int], l Window)
defl [(l Window, Stack Window)]
sls
| Just (Broadcast SomeMessage
sm) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
[(SomeMessage, Window)]
ms' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (SomeMessage
sm,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe (Stack a) -> [a]
W.integrate') X (Maybe (Stack Window))
currentStack
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SomeMessage, Window)]
ms' then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout (forall (m :: * -> *) a. m a -> Invisible m a
I forall a b. (a -> b) -> a -> b
$ [(SomeMessage, Window)]
ms' forall a. [a] -> [a] -> [a]
++ [(SomeMessage, Window)]
ms) ([Int], l Window)
defl [(l Window, Stack Window)]
sls
| Just UpdateBoring
B.UpdateBoring <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
let bs :: [Window]
bs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Stack a -> [a]
unfocused forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Groups Window
gs
Workspace String (Layout Window) Window
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a.
Message a =>
a -> Workspace String (Layout Window) Window -> X ()
sendMessageWithNoRefresh Workspace String (Layout Window) Window
ws forall a b. (a -> b) -> a -> b
$ String -> [Window] -> BoringMessage
B.Replace String
"Sublayouts" [Window]
bs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just (WithGroup Stack Window -> X (Stack Window)
f Window
w) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
, Just Stack Window
g <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w Groups Window
gs = do
Stack Window
g' <- Stack Window -> X (Stack Window)
f Stack Window
g
let gs' :: Groups Window
gs' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. Stack a -> a
W.focus Stack Window
g') Stack Window
g' forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
M.delete (forall a. Stack a -> a
W.focus Stack Window
g) Groups Window
gs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Groups Window
gs' forall a. Eq a => a -> a -> Bool
/= Groups Window
gs) forall a b. (a -> b) -> a -> b
$ Groups Window -> X ()
updateWs Groups Window
gs'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
w forall a. Eq a => a -> a -> Bool
/= forall a. Stack a -> a
W.focus Stack Window
g') forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows (forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> a
W.focus Stack Window
g')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just (MergeAll Window
w) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
let gs' :: Maybe (Groups Window)
gs' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k a. k -> a -> Map k a
M.singleton Window
w)
forall a b. (a -> b) -> a -> b
$ (forall a. Eq a => a -> Stack a -> Maybe (Stack a)
focusWindow' Window
w forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (Stack a)
W.differentiate
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Stack a -> [a]
W.integrate forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Groups Window
gs
in forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) Groups Window -> X (Maybe (Sublayout l Window))
fgs Maybe (Groups Window)
gs'
| Just (UnMergeAll Window
w) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
let ws :: [Window]
ws = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Stack a -> [a]
W.integrate forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Groups Window
gs
Window
_ = Window
w :: Window
mkSingleton :: a -> Map a (Stack a)
mkSingleton a
f = forall k a. k -> a -> Map k a
M.singleton a
f (forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [] [])
in Groups Window -> X (Maybe (Sublayout l Window))
fgs forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. a -> Map a (Stack a)
mkSingleton [Window]
ws
| Just (Merge Window
x Window
y) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
, Just (W.Stack Window
_ [Window]
xb [Window]
xn) <- Window -> Maybe (Stack Window)
findGroup Window
x
, Just Stack Window
yst <- Window -> Maybe (Stack Window)
findGroup Window
y =
let zs :: Stack Window
zs = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x [Window]
xb ([Window]
xn forall a. [a] -> [a] -> [a]
++ forall a. Stack a -> [a]
W.integrate Stack Window
yst)
in Groups Window -> X (Maybe (Sublayout l Window))
fgs forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
x Stack Window
zs forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
M.delete (forall a. Stack a -> a
W.focus Stack Window
yst) Groups Window
gs
| Just (UnMerge Window
x) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
Groups Window -> X (Maybe (Sublayout l Window))
fgs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Stack a -> a
W.focus forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
M.elems
forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe (forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (Window
xforall a. Eq a => a -> a -> Bool
/=)) Groups Window
gs
| Just (Migrate Window
x Window
y) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
, Just Stack Window
xst <- Window -> Maybe (Stack Window)
findGroup Window
x
, Just (W.Stack Window
yf [Window]
yu [Window]
yd) <- Window -> Maybe (Stack Window)
findGroup Window
y =
let zs :: Stack Window
zs = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x (Window
yfforall a. a -> [a] -> [a]
:[Window]
yu) [Window]
yd
nxsAdd :: Groups Window -> Groups Window
nxsAdd = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Stack Window
e -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. Stack a -> a
W.focus Stack Window
e) Stack Window
e) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (Window
xforall a. Eq a => a -> a -> Bool
/=) Stack Window
xst
in Groups Window -> X (Maybe (Sublayout l Window))
fgs forall a b. (a -> b) -> a -> b
$ Groups Window -> Groups Window
nxsAdd forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
x Stack Window
zs forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
M.delete Window
yf Groups Window
gs
| Bool
otherwise = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse LayoutMessages -> X (Maybe (Sublayout l Window))
catchLayoutMess (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
where gs :: Groups Window
gs = forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(l Window, Stack Window)]
sls
fgs :: Groups Window -> X (Maybe (Sublayout l Window))
fgs Groups Window
gs' = do
Maybe (Stack Window)
st <- X (Maybe (Stack Window))
currentStack
forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout (forall (m :: * -> *) a. m a -> Invisible m a
I [(SomeMessage, Window)]
ms) ([Int], l Window)
defl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a k b.
(LayoutClass layout a, Ord k) =>
([Int], layout a)
-> Maybe (Stack k)
-> Groups k
-> [(layout a, b)]
-> X [(Bool, (layout a, Stack k))]
fromGroups ([Int], l Window)
defl Maybe (Stack Window)
st Groups Window
gs' [(l Window, Stack Window)]
sls
findGroup :: Window -> Maybe (Stack Window)
findGroup Window
z = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
z Groups Window
gs) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe
forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter ((Window
z forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
W.integrate) Groups Window
gs
catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window))
catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window))
catchLayoutMess LayoutMessages
x = do
let m' :: LayoutMessages
m' = LayoutMessages
x forall a. a -> a -> a
`asTypeOf` (forall a. HasCallStack => a
undefined :: LayoutMessages)
[(SomeMessage, Window)]
ms' <- forall a b. (a -> b) -> [a] -> [b]
map (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
m',) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe (Stack a) -> [a]
W.integrate'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (Maybe (Stack Window))
currentStack
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SomeMessage, Window)]
ms'
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout (forall (m :: * -> *) a. m a -> Invisible m a
I forall a b. (a -> b) -> a -> b
$ [(SomeMessage, Window)]
ms' forall a. [a] -> [a] -> [a]
++ [(SomeMessage, Window)]
ms) ([Int], l Window)
defl [(l Window, Stack Window)]
sls
currentStack :: X (Maybe (W.Stack Window))
currentStack :: X (Maybe (Stack Window))
currentStack = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
updateGroup :: Ord a => Maybe (W.Stack a) -> Groups a -> Groups a
updateGroup :: forall a. Ord a => Maybe (Stack a) -> Groups a -> Groups a
updateGroup Maybe (Stack a)
Nothing Groups a
_ = forall a. Monoid a => a
mempty
updateGroup (Just Stack a
st) Groups a
gs = forall a. Ord a => GroupStack a -> Groups a
fromGroupStack (forall a. Ord a => Groups a -> Stack a -> GroupStack a
toGroupStack Groups a
gs Stack a
st)
updateWs :: Groups Window -> X ()
updateWs :: Groups Window -> X ()
updateWs = (WindowSet -> Maybe WindowSet) -> X ()
windowsMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Groups Window -> WindowSet -> Maybe WindowSet
updateWs'
updateWs' :: Groups Window -> WindowSet -> Maybe WindowSet
updateWs' :: Groups Window -> WindowSet -> Maybe WindowSet
updateWs' Groups Window
gs WindowSet
ws = do
Stack Window
w <- forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall a b. (a -> b) -> a -> b
$ WindowSet
ws
let w' :: Stack Window
w' = forall a. GroupStack a -> Stack a
flattenGroupStack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Groups a -> Stack a -> GroupStack a
toGroupStack Groups Window
gs forall a b. (a -> b) -> a -> b
$ Stack Window
w
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Stack Window
w forall a. Eq a => a -> a -> Bool
/= Stack Window
w'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' (forall a b. a -> b -> a
const Stack Window
w') WindowSet
ws
flattenGroupStack :: GroupStack a -> W.Stack a
flattenGroupStack :: forall a. GroupStack a -> Stack a
flattenGroupStack (W.Stack (W.Stack a
f [a]
lf [a]
rf) [Stack a]
ls [Stack a]
rs) =
let l :: [a]
l = [a]
lf forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
W.integrate) [Stack a]
ls
r :: [a]
r = [a]
rf forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Stack a -> [a]
W.integrate [Stack a]
rs
in forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [a]
l [a]
r
fromGroupStack :: (Ord a) => GroupStack a -> Groups a
fromGroupStack :: forall a. Ord a => GroupStack a -> Groups a
fromGroupStack = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Stack a -> a
W.focus forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
W.integrate
toGroupStack :: (Ord a) => Groups a -> W.Stack a -> GroupStack a
toGroupStack :: forall a. Ord a => Groups a -> Stack a -> GroupStack a
toGroupStack Groups a
gs st :: Stack a
st@(W.Stack a
f [a]
ls [a]
rs) =
forall a. a -> [a] -> [a] -> Stack a
W.Stack (forall a. HasCallStack => Maybe a -> a
fromJust (a -> Maybe (Stack a)
lu a
f)) (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe (Stack a)
lu [a]
ls) (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe (Stack a)
lu [a]
rs)
where
wset :: Set a
wset = forall a. Ord a => [a] -> Set a
S.fromList (forall a. Stack a -> [a]
W.integrate Stack a
st)
dead :: Stack a -> Maybe (Stack a)
dead = forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
wset)
refocus :: Stack a -> Maybe (Stack a)
refocus Stack a
s | a
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Stack a -> [a]
W.integrate Stack a
s
= forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Stack a -> [a]
W.integrate Stack a
s) Stack a
st
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure Stack a
s
gs' :: Groups a
gs' = forall a.
Ord a =>
(Stack a -> Maybe (Stack a)) -> Groups a -> Groups a
mapGroups (Stack a -> Maybe (Stack a)
refocus forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Stack a -> Maybe (Stack a)
dead) Groups a
gs
gset :: Set a
gset = forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Stack a -> [a]
W.integrate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$ Groups a
gs'
lu :: a -> Maybe (Stack a)
lu a
w | a
w forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
gset = a
w forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Groups a
gs'
| Bool
otherwise = forall a. a -> Maybe a
Just (forall a. a -> [a] -> [a] -> Stack a
W.Stack a
w [] [])
mapGroups :: (Ord a) => (W.Stack a -> Maybe (W.Stack a)) -> Groups a -> Groups a
mapGroups :: forall a.
Ord a =>
(Stack a -> Maybe (Stack a)) -> Groups a -> Groups a
mapGroups Stack a -> Maybe (Stack a)
f = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Stack a -> a
W.focus forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Stack a -> Maybe (Stack a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
M.elems
focusWindow' :: (Eq a) => a -> W.Stack a -> Maybe (W.Stack a)
focusWindow' :: forall a. Eq a => a -> Stack a -> Maybe (Stack a)
focusWindow' a
w Stack a
st = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ a
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Stack a -> [a]
W.integrate Stack a
st
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((a
w forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> a
W.focus) forall a. Stack a -> Stack a
W.focusDown' Stack a
st
windowsMaybe :: (WindowSet -> Maybe WindowSet) -> X ()
windowsMaybe :: (WindowSet -> Maybe WindowSet) -> X ()
windowsMaybe WindowSet -> Maybe WindowSet
f = do
XState
xst <- forall s (m :: * -> *). MonadState s m => m s
get
WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let up :: WindowSet -> m ()
up WindowSet
fws = forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
xst { windowset :: WindowSet
windowset = WindowSet
fws }
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall {m :: * -> *}. MonadState XState m => WindowSet -> m ()
up forall a b. (a -> b) -> a -> b
$ WindowSet -> Maybe WindowSet
f WindowSet
ws
unfocused :: W.Stack a -> [a]
unfocused :: forall a. Stack a -> [a]
unfocused Stack a
x = forall a. Stack a -> [a]
W.up Stack a
x forall a. [a] -> [a] -> [a]
++ forall a. Stack a -> [a]
W.down Stack a
x
toGroups :: (Ord a) => [(a1, W.Stack a)] -> Map a (W.Stack a)
toGroups :: forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(a1, Stack a)]
ws = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Stack a -> a
W.focus forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) forall a. Stack a -> a
W.focus)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a1, Stack a)]
ws
fromGroups :: (LayoutClass layout a, Ord k) =>
([Int], layout a)
-> Maybe (W.Stack k)
-> Groups k
-> [(layout a, b)]
-> X [(Bool,(layout a, W.Stack k))]
fromGroups :: forall (layout :: * -> *) a k b.
(LayoutClass layout a, Ord k) =>
([Int], layout a)
-> Maybe (Stack k)
-> Groups k
-> [(layout a, b)]
-> X [(Bool, (layout a, Stack k))]
fromGroups ([Int]
skips,layout a
defl) Maybe (Stack k)
st Groups k
gs [(layout a, b)]
sls = do
[layout a]
defls <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *} {a}. Monad m => (a -> m a) -> a -> [m a]
iterateM forall {layout :: * -> *} {a}.
LayoutClass layout a =>
layout a -> X (layout a)
nextL layout a
defl forall a. [a] -> Int -> a
!!) [Int]
skips
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a.
Ord k =>
a
-> [a]
-> Maybe (Stack k)
-> Groups k
-> [a]
-> [(Bool, (a, Stack k))]
fromGroups' layout a
defl [layout a]
defls Maybe (Stack k)
st Groups k
gs (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(layout a, b)]
sls)
where nextL :: layout a -> X (layout a)
nextL layout a
l = forall a. a -> Maybe a -> a
fromMaybe layout a
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage layout a
l (forall a. Message a => a -> SomeMessage
SomeMessage ChangeLayout
NextLayout)
iterateM :: (a -> m a) -> a -> [m a]
iterateM a -> m a
f = forall a. (a -> a) -> a -> [a]
iterate (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
fromGroups' :: (Ord k) => a -> [a] -> Maybe (W.Stack k) -> Groups k -> [a]
-> [(Bool,(a, W.Stack k))]
fromGroups' :: forall k a.
Ord k =>
a
-> [a]
-> Maybe (Stack k)
-> Groups k
-> [a]
-> [(Bool, (a, Stack k))]
fromGroups' a
defl [a]
defls Maybe (Stack k)
st Groups k
gs [a]
sls =
[ (Bool
isNew,forall {a} {b}. (a, b) -> (Maybe a, Maybe b) -> (a, b)
fromMaybe2 (a
dl, forall {a}. a -> Stack a
single k
w) (Maybe a
l, forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
w Groups k
gs))
| Maybe a
l <- forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [a]
sls forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat forall a. Maybe a
Nothing, let isNew :: Bool
isNew = forall a. Maybe a -> Bool
isNothing Maybe a
l
| a
dl <- [a]
defls forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat a
defl
| k
w <- forall a. Maybe (Stack a) -> [a]
W.integrate' forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [k]
unfocs) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Stack k)
st ]
where unfocs :: [k]
unfocs = forall a. Stack a -> [a]
unfocused forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Map k a -> [a]
M.elems Groups k
gs
single :: a -> Stack a
single a
w = forall a. a -> [a] -> [a] -> Stack a
W.Stack a
w [] []
fromMaybe2 :: (a, b) -> (Maybe a, Maybe b) -> (a, b)
fromMaybe2 (a
a,b
b) (Maybe a
x,Maybe b
y) = (forall a. a -> Maybe a -> a
fromMaybe a
a Maybe a
x, forall a. a -> Maybe a -> a
fromMaybe b
b Maybe b
y)
setStack :: Maybe (W.Stack Window) -> X ()
setStack :: Maybe (Stack Window) -> X ()
setStack Maybe (Stack Window)
x = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s { windowset :: WindowSet
windowset = (XState -> WindowSet
windowset XState
s)
{ current :: Screen String (Layout Window) Window ScreenId ScreenDetail
W.current = (forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall a b. (a -> b) -> a -> b
$ XState -> WindowSet
windowset XState
s)
{ workspace :: Workspace String (Layout Window) Window
W.workspace = (forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall a b. (a -> b) -> a -> b
$ XState -> WindowSet
windowset XState
s) { stack :: Maybe (Stack Window)
W.stack = Maybe (Stack Window)
x }}}})