{-# LANGUAGE PatternGuards, ParallelListComp, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances #-}
module XMonad.Layout.SubLayouts (
subLayout,
subTabbed,
pushGroup, pullGroup,
pushWindow, pullWindow,
onGroup, toSubl, mergeDir,
GroupMsg(..),
Broadcast(..),
defaultSublMap,
Sublayout,
)
where
import XMonad.Layout.Circle ()
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 Control.Applicative((<$>),(<*))
import Control.Arrow(Arrow(second, (&&&)))
import Control.Monad(MonadPlus(mplus), foldM, guard, when, join)
import Data.Function(on)
import Data.List(nubBy, (\\), find)
import Data.Maybe(isNothing, fromMaybe, listToMaybe, mapMaybe)
import Data.Traversable(sequenceA)
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)
subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a
subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a
subLayout nextLayout :: [Int]
nextLayout sl :: subl a
sl x :: l a
x = Sublayout subl a -> l a -> ModifiedLayout (Sublayout subl) l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Invisible [] (SomeMessage, a)
-> ([Int], subl a) -> [(subl a, Stack a)] -> Sublayout subl a
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, a)] -> Invisible [] (SomeMessage, a)
forall (m :: * -> *) a. m a -> Invisible m a
I []) ([Int]
nextLayout,subl a
sl) []) l a
x
subTabbed :: (Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) =>
l a -> ModifiedLayout (Decoration TabbedDecoration DefaultShrinker)
(ModifiedLayout (Sublayout Simplest) l) a
subTabbed :: l a
-> ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker)
(ModifiedLayout (Sublayout Simplest) l)
a
subTabbed x :: l a
x = DefaultShrinker
-> Theme
-> ModifiedLayout (Sublayout Simplest) l a
-> ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker)
(ModifiedLayout (Sublayout Simplest) l)
a
forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabs DefaultShrinker
shrinkText Theme
forall a. Default a => a
X.def (ModifiedLayout (Sublayout Simplest) l a
-> ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker)
(ModifiedLayout (Sublayout Simplest) l)
a)
-> ModifiedLayout (Sublayout Simplest) l a
-> ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker)
(ModifiedLayout (Sublayout Simplest) l)
a
forall a b. (a -> b) -> a -> b
$ [Int]
-> Simplest a -> l a -> ModifiedLayout (Sublayout Simplest) l a
forall (subl :: * -> *) a (l :: * -> *).
[Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a
subLayout [] Simplest a
forall a. Simplest a
Simplest l a
x
defaultSublMap :: XConfig l -> Map (KeyMask, KeySym) (X ())
defaultSublMap :: XConfig l -> Map (KeyMask, KeySym) (X ())
defaultSublMap (XConfig { modMask :: forall (l :: * -> *). XConfig l -> KeyMask
modMask = KeyMask
modm }) = [((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[((KeyMask
modm, KeySym
xK_space), ChangeLayout -> X ()
forall a. Message a => a -> X ()
toSubl ChangeLayout
NextLayout),
((KeyMask
modm, KeySym
xK_j), (Stack KeySym -> Stack KeySym) -> X ()
onGroup Stack KeySym -> Stack KeySym
forall a. Stack a -> Stack a
W.focusDown'),
((KeyMask
modm, KeySym
xK_k), (Stack KeySym -> Stack KeySym) -> X ()
onGroup Stack KeySym -> Stack KeySym
forall a. Stack a -> Stack a
W.focusUp'),
((KeyMask
modm, KeySym
xK_h), Resize -> X ()
forall a. Message a => a -> X ()
toSubl Resize
Shrink),
((KeyMask
modm, KeySym
xK_l), Resize -> X ()
forall a. Message a => a -> X ()
toSubl Resize
Expand),
((KeyMask
modm, KeySym
xK_Tab), (Stack KeySym -> Stack KeySym) -> X ()
onGroup Stack KeySym -> Stack KeySym
forall a. Stack a -> Stack a
W.focusDown'),
((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Tab), (Stack KeySym -> Stack KeySym) -> X ()
onGroup Stack KeySym -> Stack KeySym
forall a. Stack a -> Stack a
W.focusUp'),
((KeyMask
modm, KeySym
xK_m), (Stack KeySym -> Stack KeySym) -> X ()
onGroup Stack KeySym -> Stack KeySym
forall a. Stack a -> Stack a
focusMaster'),
((KeyMask
modm, KeySym
xK_comma), IncMasterN -> X ()
forall a. Message a => a -> X ()
toSubl (IncMasterN -> X ()) -> IncMasterN -> X ()
forall a b. (a -> b) -> a -> b
$ Int -> IncMasterN
IncMasterN 1),
((KeyMask
modm, KeySym
xK_period), IncMasterN -> X ()
forall a. Message a => a -> X ()
toSubl (IncMasterN -> X ()) -> IncMasterN -> X ()
forall a b. (a -> b) -> a -> b
$ Int -> IncMasterN
IncMasterN (-1)),
((KeyMask
modm, KeySym
xK_Return), (Stack KeySym -> Stack KeySym) -> X ()
onGroup Stack KeySym -> Stack KeySym
forall a. Stack a -> Stack a
swapMaster')
]
where
focusMaster' :: Stack a -> Stack a
focusMaster' st :: Stack a
st = let (f :: a
f:fs :: [a]
fs) = Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
st
in a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [] [a]
fs
swapMaster' :: Stack a -> Stack a
swapMaster' (W.Stack f :: a
f u :: [a]
u d :: [a]
d) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [] ([a] -> Stack a) -> [a] -> Stack a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
u [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
d
data Sublayout l a = Sublayout
{ Sublayout l a -> Invisible [] (SomeMessage, a)
delayMess :: Invisible [] (SomeMessage,a)
, Sublayout l a -> ([Int], l a)
def :: ([Int], l a)
, Sublayout l a -> [(l a, Stack a)]
subls :: [(l a,W.Stack a)]
}
deriving (ReadPrec [Sublayout l a]
ReadPrec (Sublayout l a)
Int -> ReadS (Sublayout l a)
ReadS [Sublayout l a]
(Int -> ReadS (Sublayout l a))
-> ReadS [Sublayout l a]
-> ReadPrec (Sublayout l a)
-> ReadPrec [Sublayout l a]
-> Read (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
[Sublayout l a] -> ShowS
Sublayout l a -> String
(Int -> Sublayout l a -> ShowS)
-> (Sublayout l a -> String)
-> ([Sublayout l a] -> ShowS)
-> Show (Sublayout l a)
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)
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
deriving (Typeable)
mergeDir :: (W.Stack Window -> W.Stack Window) -> Window -> GroupMsg Window
mergeDir :: (Stack KeySym -> Stack KeySym) -> KeySym -> GroupMsg KeySym
mergeDir f :: Stack KeySym -> Stack KeySym
f w :: KeySym
w = (Stack KeySym -> X (Stack KeySym)) -> KeySym -> GroupMsg KeySym
forall a. (Stack a -> X (Stack a)) -> a -> GroupMsg a
WithGroup Stack KeySym -> X (Stack KeySym)
g KeySym
w
where g :: Stack KeySym -> X (Stack KeySym)
g cs :: Stack KeySym
cs = do
let onlyOthers :: Stack KeySym -> Maybe (Stack KeySym)
onlyOthers = (KeySym -> Bool) -> Stack KeySym -> Maybe (Stack KeySym)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (KeySym -> [KeySym] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Stack KeySym -> [KeySym]
forall a. Stack a -> [a]
W.integrate Stack KeySym
cs)
(Maybe (Stack KeySym) -> (Stack KeySym -> X ()) -> X ())
-> (Stack KeySym -> X ()) -> Maybe (Stack KeySym) -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe (Stack KeySym) -> (Stack KeySym -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (GroupMsg KeySym -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg KeySym -> X ())
-> (Stack KeySym -> GroupMsg KeySym) -> Stack KeySym -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeySym -> KeySym -> GroupMsg KeySym
forall a. a -> a -> GroupMsg a
Merge (Stack KeySym -> KeySym
forall a. Stack a -> a
W.focus Stack KeySym
cs) (KeySym -> GroupMsg KeySym)
-> (Stack KeySym -> KeySym) -> Stack KeySym -> GroupMsg KeySym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack KeySym -> KeySym
forall a. Stack a -> a
W.focus (Stack KeySym -> KeySym)
-> (Stack KeySym -> Stack KeySym) -> Stack KeySym -> KeySym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack KeySym -> Stack KeySym
f)
(Maybe (Stack KeySym) -> X ()) -> X (Maybe (Stack KeySym)) -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Maybe (Stack KeySym) -> Maybe (Stack KeySym))
-> X (Maybe (Stack KeySym)) -> X (Maybe (Stack KeySym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stack KeySym -> Maybe (Stack KeySym)
onlyOthers (Stack KeySym -> Maybe (Stack KeySym))
-> Maybe (Stack KeySym) -> Maybe (Stack KeySym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) X (Maybe (Stack KeySym))
currentStack
Stack KeySym -> X (Stack KeySym)
forall (m :: * -> *) a. Monad m => a -> m a
return Stack KeySym
cs
data Broadcast = Broadcast SomeMessage
deriving (Typeable)
instance Message Broadcast
instance Typeable a => Message (GroupMsg a)
pullGroup,pushGroup,pullWindow,pushWindow :: Direction2D -> Navigate
pullGroup :: Direction2D -> Navigate
pullGroup = (KeySym -> KeySym -> X ()) -> Direction2D -> Navigate
mergeNav (\o :: KeySym
o c :: KeySym
c -> GroupMsg KeySym -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg KeySym -> X ()) -> GroupMsg KeySym -> X ()
forall a b. (a -> b) -> a -> b
$ KeySym -> KeySym -> GroupMsg KeySym
forall a. a -> a -> GroupMsg a
Merge KeySym
o KeySym
c)
pushGroup :: Direction2D -> Navigate
pushGroup = (KeySym -> KeySym -> X ()) -> Direction2D -> Navigate
mergeNav (\o :: KeySym
o c :: KeySym
c -> GroupMsg KeySym -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg KeySym -> X ()) -> GroupMsg KeySym -> X ()
forall a b. (a -> b) -> a -> b
$ KeySym -> KeySym -> GroupMsg KeySym
forall a. a -> a -> GroupMsg a
Merge KeySym
c KeySym
o)
pullWindow :: Direction2D -> Navigate
pullWindow = (KeySym -> KeySym -> X ()) -> Direction2D -> Navigate
mergeNav (\o :: KeySym
o c :: KeySym
c -> GroupMsg KeySym -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg KeySym -> X ()) -> GroupMsg KeySym -> X ()
forall a b. (a -> b) -> a -> b
$ KeySym -> KeySym -> GroupMsg KeySym
forall a. a -> a -> GroupMsg a
Migrate KeySym
o KeySym
c)
pushWindow :: Direction2D -> Navigate
pushWindow = (KeySym -> KeySym -> X ()) -> Direction2D -> Navigate
mergeNav (\o :: KeySym
o c :: KeySym
c -> GroupMsg KeySym -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg KeySym -> X ()) -> GroupMsg KeySym -> X ()
forall a b. (a -> b) -> a -> b
$ KeySym -> KeySym -> GroupMsg KeySym
forall a. a -> a -> GroupMsg a
Migrate KeySym
c KeySym
o)
mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav :: (KeySym -> KeySym -> X ()) -> Direction2D -> Navigate
mergeNav f :: KeySym -> KeySym -> X ()
f = (KeySym -> X ()) -> Direction2D -> Navigate
Apply (\o :: KeySym
o -> (KeySym -> X ()) -> X ()
withFocused (KeySym -> KeySym -> X ()
f KeySym
o))
onGroup :: (W.Stack Window -> W.Stack Window) -> X ()
onGroup :: (Stack KeySym -> Stack KeySym) -> X ()
onGroup f :: Stack KeySym -> Stack KeySym
f = (KeySym -> X ()) -> X ()
withFocused (GroupMsg KeySym -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg KeySym -> X ())
-> (KeySym -> GroupMsg KeySym) -> KeySym -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack KeySym -> X (Stack KeySym)) -> KeySym -> GroupMsg KeySym
forall a. (Stack a -> X (Stack a)) -> a -> GroupMsg a
WithGroup (Stack KeySym -> X (Stack KeySym)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stack KeySym -> X (Stack KeySym))
-> (Stack KeySym -> Stack KeySym)
-> Stack KeySym
-> X (Stack KeySym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack KeySym -> Stack KeySym
f))
toSubl :: (Message a) => a -> X ()
toSubl :: a -> X ()
toSubl m :: a
m = (KeySym -> X ()) -> X ()
withFocused (GroupMsg KeySym -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg KeySym -> X ())
-> (KeySym -> GroupMsg KeySym) -> KeySym -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeMessage -> KeySym -> GroupMsg KeySym
forall a. SomeMessage -> a -> GroupMsg a
SubMessage (a -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage a
m))
instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where
modifyLayout :: Sublayout l KeySym
-> Workspace String (l KeySym) KeySym
-> Rectangle
-> X ([(KeySym, Rectangle)], Maybe (l KeySym))
modifyLayout (Sublayout { subls :: forall (l :: * -> *) a. Sublayout l a -> [(l a, Stack a)]
subls = [(l KeySym, Stack KeySym)]
osls }) (W.Workspace i :: String
i la :: l KeySym
la st :: Maybe (Stack KeySym)
st) r :: Rectangle
r = do
let gs' :: Groups KeySym
gs' = Maybe (Stack KeySym) -> Groups KeySym -> Groups KeySym
forall a. Ord a => Maybe (Stack a) -> Groups a -> Groups a
updateGroup Maybe (Stack KeySym)
st (Groups KeySym -> Groups KeySym) -> Groups KeySym -> Groups KeySym
forall a b. (a -> b) -> a -> b
$ [(l KeySym, Stack KeySym)] -> Groups KeySym
forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(l KeySym, Stack KeySym)]
osls
st' :: Maybe (Stack KeySym)
st' = (KeySym -> Bool) -> Stack KeySym -> Maybe (Stack KeySym)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (KeySym -> [KeySym] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Groups KeySym -> [KeySym]
forall k a. Map k a -> [k]
M.keys Groups KeySym
gs') (Stack KeySym -> Maybe (Stack KeySym))
-> Maybe (Stack KeySym) -> Maybe (Stack KeySym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Stack KeySym)
st
Groups KeySym -> X ()
updateWs Groups KeySym
gs'
Maybe (Stack KeySym)
oldStack <- (XState -> Maybe (Stack KeySym)) -> X (Maybe (Stack KeySym))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> Maybe (Stack KeySym)) -> X (Maybe (Stack KeySym)))
-> (XState -> Maybe (Stack KeySym)) -> X (Maybe (Stack KeySym))
forall a b. (a -> b) -> a -> b
$ Workspace String (Layout KeySym) KeySym -> Maybe (Stack KeySym)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout KeySym) KeySym -> Maybe (Stack KeySym))
-> (XState -> Workspace String (Layout KeySym) KeySym)
-> XState
-> Maybe (Stack KeySym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace String (Layout KeySym) KeySym
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace String (Layout KeySym) KeySym)
-> (XState
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout KeySym) KeySym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> (XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> XState
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
windowset
Maybe (Stack KeySym) -> X ()
setStack Maybe (Stack KeySym)
st'
Workspace String (l KeySym) KeySym
-> Rectangle -> X ([(KeySym, Rectangle)], Maybe (l KeySym))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l KeySym
-> Maybe (Stack KeySym)
-> Workspace String (l KeySym) KeySym
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
i l KeySym
la Maybe (Stack KeySym)
st') Rectangle
r X ([(KeySym, Rectangle)], Maybe (l KeySym))
-> X () -> X ([(KeySym, Rectangle)], Maybe (l KeySym))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Maybe (Stack KeySym) -> X ()
setStack Maybe (Stack KeySym)
oldStack
redoLayout :: Sublayout l KeySym
-> Rectangle
-> Maybe (Stack KeySym)
-> [(KeySym, Rectangle)]
-> X ([(KeySym, Rectangle)], Maybe (Sublayout l KeySym))
redoLayout (Sublayout { delayMess :: forall (l :: * -> *) a.
Sublayout l a -> Invisible [] (SomeMessage, a)
delayMess = I ms :: [(SomeMessage, KeySym)]
ms, def :: forall (l :: * -> *) a. Sublayout l a -> ([Int], l a)
def = ([Int], l KeySym)
defl, subls :: forall (l :: * -> *) a. Sublayout l a -> [(l a, Stack a)]
subls = [(l KeySym, Stack KeySym)]
osls }) _r :: Rectangle
_r st :: Maybe (Stack KeySym)
st arrs :: [(KeySym, Rectangle)]
arrs = do
let gs' :: Groups KeySym
gs' = Maybe (Stack KeySym) -> Groups KeySym -> Groups KeySym
forall a. Ord a => Maybe (Stack a) -> Groups a -> Groups a
updateGroup Maybe (Stack KeySym)
st (Groups KeySym -> Groups KeySym) -> Groups KeySym -> Groups KeySym
forall a b. (a -> b) -> a -> b
$ [(l KeySym, Stack KeySym)] -> Groups KeySym
forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(l KeySym, Stack KeySym)]
osls
[(Bool, (l KeySym, Stack KeySym))]
sls <- ([Int], l KeySym)
-> Maybe (Stack KeySym)
-> Groups KeySym
-> [(l KeySym, Stack KeySym)]
-> X [(Bool, (l KeySym, Stack KeySym))]
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 KeySym)
defl Maybe (Stack KeySym)
st Groups KeySym
gs' [(l KeySym, Stack KeySym)]
osls
let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> (l Window) -> Bool
-> (Maybe (W.Stack Window)) -> X ([(Window, Rectangle)], l Window)
newL :: Rectangle
-> String
-> l KeySym
-> Bool
-> Maybe (Stack KeySym)
-> X ([(KeySym, Rectangle)], l KeySym)
newL rect :: Rectangle
rect n :: String
n ol :: l KeySym
ol isNew :: Bool
isNew sst :: Maybe (Stack KeySym)
sst = do
Maybe (Stack KeySym)
orgStack <- X (Maybe (Stack KeySym))
currentStack
let handle :: layout a -> (SomeMessage, b) -> X (layout a)
handle l :: layout a
l (y :: SomeMessage
y,_)
| Bool -> Bool
not Bool
isNew = layout a -> Maybe (layout a) -> layout a
forall a. a -> Maybe a -> a
fromMaybe layout a
l (Maybe (layout a) -> layout a)
-> X (Maybe (layout a)) -> X (layout a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> layout a -> SomeMessage -> X (Maybe (layout a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage layout a
l SomeMessage
y
| Bool
otherwise = layout a -> X (layout a)
forall (m :: * -> *) a. Monad m => a -> m a
return layout a
l
kms :: [(SomeMessage, KeySym)]
kms = ((SomeMessage, KeySym) -> Bool)
-> [(SomeMessage, KeySym)] -> [(SomeMessage, KeySym)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((KeySym -> [KeySym] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Groups KeySym -> [KeySym]
forall k a. Map k a -> [k]
M.keys Groups KeySym
gs') (KeySym -> Bool)
-> ((SomeMessage, KeySym) -> KeySym)
-> (SomeMessage, KeySym)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeMessage, KeySym) -> KeySym
forall a b. (a, b) -> b
snd) [(SomeMessage, KeySym)]
ms
Maybe (Stack KeySym) -> X ()
setStack Maybe (Stack KeySym)
sst
l KeySym
nl <- (l KeySym -> (SomeMessage, KeySym) -> X (l KeySym))
-> l KeySym -> [(SomeMessage, KeySym)] -> X (l KeySym)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM l KeySym -> (SomeMessage, KeySym) -> X (l KeySym)
forall (layout :: * -> *) a b.
LayoutClass layout a =>
layout a -> (SomeMessage, b) -> X (layout a)
handle l KeySym
ol ([(SomeMessage, KeySym)] -> X (l KeySym))
-> [(SomeMessage, KeySym)] -> X (l KeySym)
forall a b. (a -> b) -> a -> b
$ ((SomeMessage, KeySym) -> Bool)
-> [(SomeMessage, KeySym)] -> [(SomeMessage, KeySym)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((KeySym -> [KeySym] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Maybe (Stack KeySym) -> [KeySym]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack KeySym)
sst) (KeySym -> Bool)
-> ((SomeMessage, KeySym) -> KeySym)
-> (SomeMessage, KeySym)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeMessage, KeySym) -> KeySym
forall a b. (a, b) -> b
snd) [(SomeMessage, KeySym)]
kms
([(KeySym, Rectangle)], Maybe (l KeySym))
result <- Workspace String (l KeySym) KeySym
-> Rectangle -> X ([(KeySym, Rectangle)], Maybe (l KeySym))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l KeySym
-> Maybe (Stack KeySym)
-> Workspace String (l KeySym) KeySym
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
n l KeySym
nl Maybe (Stack KeySym)
sst) Rectangle
rect
Maybe (Stack KeySym) -> X ()
setStack Maybe (Stack KeySym)
orgStack
([(KeySym, Rectangle)], l KeySym)
-> X ([(KeySym, Rectangle)], l KeySym)
forall (m :: * -> *) a. Monad m => a -> m a
return (([(KeySym, Rectangle)], l KeySym)
-> X ([(KeySym, Rectangle)], l KeySym))
-> ([(KeySym, Rectangle)], l KeySym)
-> X ([(KeySym, Rectangle)], l KeySym)
forall a b. (a -> b) -> a -> b
$ l KeySym -> Maybe (l KeySym) -> l KeySym
forall a. a -> Maybe a -> a
fromMaybe l KeySym
nl (Maybe (l KeySym) -> l KeySym)
-> ([(KeySym, Rectangle)], Maybe (l KeySym))
-> ([(KeySym, Rectangle)], l KeySym)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
`second` ([(KeySym, Rectangle)], Maybe (l KeySym))
result
(urls :: [X ([(KeySym, Rectangle)], l KeySym)]
urls,ssts :: [Maybe (Stack KeySym)]
ssts) = [(X ([(KeySym, Rectangle)], l KeySym), Maybe (Stack KeySym))]
-> ([X ([(KeySym, Rectangle)], l KeySym)], [Maybe (Stack KeySym)])
forall a b. [(a, b)] -> ([a], [b])
unzip [ (Rectangle
-> String
-> l KeySym
-> Bool
-> Maybe (Stack KeySym)
-> X ([(KeySym, Rectangle)], l KeySym)
forall (l :: * -> *).
LayoutClass l KeySym =>
Rectangle
-> String
-> l KeySym
-> Bool
-> Maybe (Stack KeySym)
-> X ([(KeySym, Rectangle)], l KeySym)
newL Rectangle
gr String
i l KeySym
l Bool
isNew Maybe (Stack KeySym)
sst, Maybe (Stack KeySym)
sst)
| (isNew :: Bool
isNew,(l :: l KeySym
l,_st :: Stack KeySym
_st)) <- [(Bool, (l KeySym, Stack KeySym))]
sls
| String
i <- (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [ 0 :: Int .. ]
| (k :: KeySym
k,gr :: Rectangle
gr) <- [(KeySym, Rectangle)]
arrs, let sst :: Maybe (Stack KeySym)
sst = KeySym -> Groups KeySym -> Maybe (Stack KeySym)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeySym
k Groups KeySym
gs' ]
[([(KeySym, Rectangle)], l KeySym)]
arrs' <- [X ([(KeySym, Rectangle)], l KeySym)]
-> X [([(KeySym, Rectangle)], l KeySym)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [X ([(KeySym, Rectangle)], l KeySym)]
urls
Maybe (Sublayout l KeySym)
sls' <- Sublayout l KeySym -> Maybe (Sublayout l KeySym)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sublayout l KeySym -> Maybe (Sublayout l KeySym))
-> ([(Bool, (l KeySym, Stack KeySym))] -> Sublayout l KeySym)
-> [(Bool, (l KeySym, Stack KeySym))]
-> Maybe (Sublayout l KeySym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Invisible [] (SomeMessage, KeySym)
-> ([Int], l KeySym)
-> [(l KeySym, Stack KeySym)]
-> Sublayout l KeySym
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, KeySym)] -> Invisible [] (SomeMessage, KeySym)
forall (m :: * -> *) a. m a -> Invisible m a
I []) ([Int], l KeySym)
defl ([(l KeySym, Stack KeySym)] -> Sublayout l KeySym)
-> ([(Bool, (l KeySym, Stack KeySym))]
-> [(l KeySym, Stack KeySym)])
-> [(Bool, (l KeySym, Stack KeySym))]
-> Sublayout l KeySym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, (l KeySym, Stack KeySym)) -> (l KeySym, Stack KeySym))
-> [(Bool, (l KeySym, Stack KeySym))] -> [(l KeySym, Stack KeySym)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, (l KeySym, Stack KeySym)) -> (l KeySym, Stack KeySym)
forall a b. (a, b) -> b
snd ([(Bool, (l KeySym, Stack KeySym))] -> Maybe (Sublayout l KeySym))
-> X [(Bool, (l KeySym, Stack KeySym))]
-> X (Maybe (Sublayout l KeySym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Int], l KeySym)
-> Maybe (Stack KeySym)
-> Groups KeySym
-> [(l KeySym, Stack KeySym)]
-> X [(Bool, (l KeySym, Stack KeySym))]
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 KeySym)
defl Maybe (Stack KeySym)
st Groups KeySym
gs'
[ (l KeySym
l,Stack KeySym
s) | (_,l :: l KeySym
l) <- [([(KeySym, Rectangle)], l KeySym)]
arrs' | (Just s :: Stack KeySym
s) <- [Maybe (Stack KeySym)]
ssts ]
([(KeySym, Rectangle)], Maybe (Sublayout l KeySym))
-> X ([(KeySym, Rectangle)], Maybe (Sublayout l KeySym))
forall (m :: * -> *) a. Monad m => a -> m a
return ((([(KeySym, Rectangle)], l KeySym) -> [(KeySym, Rectangle)])
-> [([(KeySym, Rectangle)], l KeySym)] -> [(KeySym, Rectangle)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(KeySym, Rectangle)], l KeySym) -> [(KeySym, Rectangle)]
forall a b. (a, b) -> a
fst [([(KeySym, Rectangle)], l KeySym)]
arrs', Maybe (Sublayout l KeySym)
sls')
handleMess :: Sublayout l KeySym -> SomeMessage -> X (Maybe (Sublayout l KeySym))
handleMess (Sublayout (I ms :: [(SomeMessage, KeySym)]
ms) defl :: ([Int], l KeySym)
defl sls :: [(l KeySym, Stack KeySym)]
sls) m :: SomeMessage
m
| Just (SubMessage sm :: SomeMessage
sm w :: KeySym
w) <- SomeMessage -> Maybe (GroupMsg KeySym)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym)))
-> Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym))
forall a b. (a -> b) -> a -> b
$ Sublayout l KeySym -> Maybe (Sublayout l KeySym)
forall a. a -> Maybe a
Just (Sublayout l KeySym -> Maybe (Sublayout l KeySym))
-> Sublayout l KeySym -> Maybe (Sublayout l KeySym)
forall a b. (a -> b) -> a -> b
$ Invisible [] (SomeMessage, KeySym)
-> ([Int], l KeySym)
-> [(l KeySym, Stack KeySym)]
-> Sublayout l KeySym
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, KeySym)] -> Invisible [] (SomeMessage, KeySym)
forall (m :: * -> *) a. m a -> Invisible m a
I ((SomeMessage
sm,KeySym
w)(SomeMessage, KeySym)
-> [(SomeMessage, KeySym)] -> [(SomeMessage, KeySym)]
forall a. a -> [a] -> [a]
:[(SomeMessage, KeySym)]
ms)) ([Int], l KeySym)
defl [(l KeySym, Stack KeySym)]
sls
| Just (Broadcast sm :: SomeMessage
sm) <- SomeMessage -> Maybe Broadcast
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
[(SomeMessage, KeySym)]
ms' <- (Maybe (Stack KeySym) -> [(SomeMessage, KeySym)])
-> X (Maybe (Stack KeySym)) -> X [(SomeMessage, KeySym)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SomeMessage] -> [KeySym] -> [(SomeMessage, KeySym)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SomeMessage -> [SomeMessage]
forall a. a -> [a]
repeat SomeMessage
sm) ([KeySym] -> [(SomeMessage, KeySym)])
-> (Maybe (Stack KeySym) -> [KeySym])
-> Maybe (Stack KeySym)
-> [(SomeMessage, KeySym)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack KeySym) -> [KeySym]
forall a. Maybe (Stack a) -> [a]
W.integrate') X (Maybe (Stack KeySym))
currentStack
Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym)))
-> Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym))
forall a b. (a -> b) -> a -> b
$ if [(SomeMessage, KeySym)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SomeMessage, KeySym)]
ms' then Maybe (Sublayout l KeySym)
forall a. Maybe a
Nothing
else Sublayout l KeySym -> Maybe (Sublayout l KeySym)
forall a. a -> Maybe a
Just (Sublayout l KeySym -> Maybe (Sublayout l KeySym))
-> Sublayout l KeySym -> Maybe (Sublayout l KeySym)
forall a b. (a -> b) -> a -> b
$ Invisible [] (SomeMessage, KeySym)
-> ([Int], l KeySym)
-> [(l KeySym, Stack KeySym)]
-> Sublayout l KeySym
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, KeySym)] -> Invisible [] (SomeMessage, KeySym)
forall (m :: * -> *) a. m a -> Invisible m a
I ([(SomeMessage, KeySym)] -> Invisible [] (SomeMessage, KeySym))
-> [(SomeMessage, KeySym)] -> Invisible [] (SomeMessage, KeySym)
forall a b. (a -> b) -> a -> b
$ [(SomeMessage, KeySym)]
ms' [(SomeMessage, KeySym)]
-> [(SomeMessage, KeySym)] -> [(SomeMessage, KeySym)]
forall a. [a] -> [a] -> [a]
++ [(SomeMessage, KeySym)]
ms) ([Int], l KeySym)
defl [(l KeySym, Stack KeySym)]
sls
| Just B.UpdateBoring <- SomeMessage -> Maybe UpdateBoring
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
let bs :: [KeySym]
bs = (Stack KeySym -> [KeySym]) -> [Stack KeySym] -> [KeySym]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stack KeySym -> [KeySym]
forall a. Stack a -> [a]
unfocused ([Stack KeySym] -> [KeySym]) -> [Stack KeySym] -> [KeySym]
forall a b. (a -> b) -> a -> b
$ Groups KeySym -> [Stack KeySym]
forall k a. Map k a -> [a]
M.elems Groups KeySym
gs
Workspace String (Layout KeySym) KeySym
ws <- (XState -> Workspace String (Layout KeySym) KeySym)
-> X (Workspace String (Layout KeySym) KeySym)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace String (Layout KeySym) KeySym
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace String (Layout KeySym) KeySym)
-> (XState
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout KeySym) KeySym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> (XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> XState
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
windowset)
(BoringMessage -> Workspace String (Layout KeySym) KeySym -> X ())
-> Workspace String (Layout KeySym) KeySym -> BoringMessage -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip BoringMessage -> Workspace String (Layout KeySym) KeySym -> X ()
forall a.
Message a =>
a -> Workspace String (Layout KeySym) KeySym -> X ()
sendMessageWithNoRefresh Workspace String (Layout KeySym) KeySym
ws (BoringMessage -> X ()) -> BoringMessage -> X ()
forall a b. (a -> b) -> a -> b
$ String -> [KeySym] -> BoringMessage
B.Replace "Sublayouts" [KeySym]
bs
Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Sublayout l KeySym)
forall a. Maybe a
Nothing
| Just (WithGroup f :: Stack KeySym -> X (Stack KeySym)
f w :: KeySym
w) <- SomeMessage -> Maybe (GroupMsg KeySym)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
, Just g :: Stack KeySym
g <- KeySym -> Groups KeySym -> Maybe (Stack KeySym)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeySym
w Groups KeySym
gs = do
Stack KeySym
g' <- Stack KeySym -> X (Stack KeySym)
f Stack KeySym
g
let gs' :: Groups KeySym
gs' = KeySym -> Stack KeySym -> Groups KeySym -> Groups KeySym
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Stack KeySym -> KeySym
forall a. Stack a -> a
W.focus Stack KeySym
g') Stack KeySym
g' (Groups KeySym -> Groups KeySym) -> Groups KeySym -> Groups KeySym
forall a b. (a -> b) -> a -> b
$ KeySym -> Groups KeySym -> Groups KeySym
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Stack KeySym -> KeySym
forall a. Stack a -> a
W.focus Stack KeySym
g) Groups KeySym
gs
Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Groups KeySym
gs' Groups KeySym -> Groups KeySym -> Bool
forall a. Eq a => a -> a -> Bool
/= Groups KeySym
gs) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ Groups KeySym -> X ()
updateWs Groups KeySym
gs'
Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KeySym
w KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
/= Stack KeySym -> KeySym
forall a. Stack a -> a
W.focus Stack KeySym
g') (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ()
windows (KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
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 (KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ Stack KeySym -> KeySym
forall a. Stack a -> a
W.focus Stack KeySym
g')
Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Sublayout l KeySym)
forall a. Maybe a
Nothing
| Just (MergeAll w :: KeySym
w) <- SomeMessage -> Maybe (GroupMsg KeySym)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
let gs' :: Maybe (Groups KeySym)
gs' = (Stack KeySym -> Groups KeySym)
-> Maybe (Stack KeySym) -> Maybe (Groups KeySym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KeySym -> Stack KeySym -> Groups KeySym
forall k a. k -> a -> Map k a
M.singleton KeySym
w)
(Maybe (Stack KeySym) -> Maybe (Groups KeySym))
-> Maybe (Stack KeySym) -> Maybe (Groups KeySym)
forall a b. (a -> b) -> a -> b
$ (KeySym -> Stack KeySym -> Maybe (Stack KeySym)
forall a. Eq a => a -> Stack a -> Maybe (Stack a)
focusWindow' KeySym
w (Stack KeySym -> Maybe (Stack KeySym))
-> Maybe (Stack KeySym) -> Maybe (Stack KeySym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe (Stack KeySym) -> Maybe (Stack KeySym))
-> Maybe (Stack KeySym) -> Maybe (Stack KeySym)
forall a b. (a -> b) -> a -> b
$ [KeySym] -> Maybe (Stack KeySym)
forall a. [a] -> Maybe (Stack a)
W.differentiate
([KeySym] -> Maybe (Stack KeySym))
-> [KeySym] -> Maybe (Stack KeySym)
forall a b. (a -> b) -> a -> b
$ (Stack KeySym -> [KeySym]) -> [Stack KeySym] -> [KeySym]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stack KeySym -> [KeySym]
forall a. Stack a -> [a]
W.integrate ([Stack KeySym] -> [KeySym]) -> [Stack KeySym] -> [KeySym]
forall a b. (a -> b) -> a -> b
$ Groups KeySym -> [Stack KeySym]
forall k a. Map k a -> [a]
M.elems Groups KeySym
gs
in X (Maybe (Sublayout l KeySym))
-> (Groups KeySym -> X (Maybe (Sublayout l KeySym)))
-> Maybe (Groups KeySym)
-> X (Maybe (Sublayout l KeySym))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Sublayout l KeySym)
forall a. Maybe a
Nothing) Groups KeySym -> X (Maybe (Sublayout l KeySym))
fgs Maybe (Groups KeySym)
gs'
| Just (UnMergeAll w :: KeySym
w) <- SomeMessage -> Maybe (GroupMsg KeySym)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
let ws :: [KeySym]
ws = (Stack KeySym -> [KeySym]) -> [Stack KeySym] -> [KeySym]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stack KeySym -> [KeySym]
forall a. Stack a -> [a]
W.integrate ([Stack KeySym] -> [KeySym]) -> [Stack KeySym] -> [KeySym]
forall a b. (a -> b) -> a -> b
$ Groups KeySym -> [Stack KeySym]
forall k a. Map k a -> [a]
M.elems Groups KeySym
gs
KeySym
_ = KeySym
w :: Window
mkSingleton :: a -> Map a (Stack a)
mkSingleton f :: a
f = a -> Stack a -> Map a (Stack a)
forall k a. k -> a -> Map k a
M.singleton a
f (a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [] [])
in Groups KeySym -> X (Maybe (Sublayout l KeySym))
fgs (Groups KeySym -> X (Maybe (Sublayout l KeySym)))
-> Groups KeySym -> X (Maybe (Sublayout l KeySym))
forall a b. (a -> b) -> a -> b
$ [Groups KeySym] -> Groups KeySym
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Groups KeySym] -> Groups KeySym)
-> [Groups KeySym] -> Groups KeySym
forall a b. (a -> b) -> a -> b
$ (KeySym -> Groups KeySym) -> [KeySym] -> [Groups KeySym]
forall a b. (a -> b) -> [a] -> [b]
map KeySym -> Groups KeySym
forall a. a -> Map a (Stack a)
mkSingleton [KeySym]
ws
| Just (Merge x :: KeySym
x y :: KeySym
y) <- SomeMessage -> Maybe (GroupMsg KeySym)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
, Just (W.Stack _ xb :: [KeySym]
xb xn :: [KeySym]
xn) <- KeySym -> Maybe (Stack KeySym)
findGroup KeySym
x
, Just yst :: Stack KeySym
yst <- KeySym -> Maybe (Stack KeySym)
findGroup KeySym
y =
let zs :: Stack KeySym
zs = KeySym -> [KeySym] -> [KeySym] -> Stack KeySym
forall a. a -> [a] -> [a] -> Stack a
W.Stack KeySym
x [KeySym]
xb ([KeySym]
xn [KeySym] -> [KeySym] -> [KeySym]
forall a. [a] -> [a] -> [a]
++ Stack KeySym -> [KeySym]
forall a. Stack a -> [a]
W.integrate Stack KeySym
yst)
in Groups KeySym -> X (Maybe (Sublayout l KeySym))
fgs (Groups KeySym -> X (Maybe (Sublayout l KeySym)))
-> Groups KeySym -> X (Maybe (Sublayout l KeySym))
forall a b. (a -> b) -> a -> b
$ KeySym -> Stack KeySym -> Groups KeySym -> Groups KeySym
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert KeySym
x Stack KeySym
zs (Groups KeySym -> Groups KeySym) -> Groups KeySym -> Groups KeySym
forall a b. (a -> b) -> a -> b
$ KeySym -> Groups KeySym -> Groups KeySym
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Stack KeySym -> KeySym
forall a. Stack a -> a
W.focus Stack KeySym
yst) Groups KeySym
gs
| Just (UnMerge x :: KeySym
x) <- SomeMessage -> Maybe (GroupMsg KeySym)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
Groups KeySym -> X (Maybe (Sublayout l KeySym))
fgs (Groups KeySym -> X (Maybe (Sublayout l KeySym)))
-> (Groups KeySym -> Groups KeySym)
-> Groups KeySym
-> X (Maybe (Sublayout l KeySym))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(KeySym, Stack KeySym)] -> Groups KeySym
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(KeySym, Stack KeySym)] -> Groups KeySym)
-> (Groups KeySym -> [(KeySym, Stack KeySym)])
-> Groups KeySym
-> Groups KeySym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack KeySym -> (KeySym, Stack KeySym))
-> [Stack KeySym] -> [(KeySym, Stack KeySym)]
forall a b. (a -> b) -> [a] -> [b]
map (Stack KeySym -> KeySym
forall a. Stack a -> a
W.focus (Stack KeySym -> KeySym)
-> (Stack KeySym -> Stack KeySym)
-> Stack KeySym
-> (KeySym, Stack KeySym)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Stack KeySym -> Stack KeySym
forall a. a -> a
id) ([Stack KeySym] -> [(KeySym, Stack KeySym)])
-> (Groups KeySym -> [Stack KeySym])
-> Groups KeySym
-> [(KeySym, Stack KeySym)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Groups KeySym -> [Stack KeySym]
forall k a. Map k a -> [a]
M.elems
(Groups KeySym -> X (Maybe (Sublayout l KeySym)))
-> Groups KeySym -> X (Maybe (Sublayout l KeySym))
forall a b. (a -> b) -> a -> b
$ (Stack KeySym -> Maybe (Stack KeySym))
-> Groups KeySym -> Groups KeySym
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe ((KeySym -> Bool) -> Stack KeySym -> Maybe (Stack KeySym)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (KeySym
xKeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
/=)) Groups KeySym
gs
| Just (Migrate x :: KeySym
x y :: KeySym
y) <- SomeMessage -> Maybe (GroupMsg KeySym)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
, Just xst :: Stack KeySym
xst <- KeySym -> Maybe (Stack KeySym)
findGroup KeySym
x
, Just (W.Stack yf :: KeySym
yf yu :: [KeySym]
yu yd :: [KeySym]
yd) <- KeySym -> Maybe (Stack KeySym)
findGroup KeySym
y =
let zs :: Stack KeySym
zs = KeySym -> [KeySym] -> [KeySym] -> Stack KeySym
forall a. a -> [a] -> [a] -> Stack a
W.Stack KeySym
x (KeySym
yfKeySym -> [KeySym] -> [KeySym]
forall a. a -> [a] -> [a]
:[KeySym]
yu) [KeySym]
yd
nxsAdd :: Groups KeySym -> Groups KeySym
nxsAdd = (Groups KeySym -> Groups KeySym)
-> (Stack KeySym -> Groups KeySym -> Groups KeySym)
-> Maybe (Stack KeySym)
-> Groups KeySym
-> Groups KeySym
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Groups KeySym -> Groups KeySym
forall a. a -> a
id (\e :: Stack KeySym
e -> KeySym -> Stack KeySym -> Groups KeySym -> Groups KeySym
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Stack KeySym -> KeySym
forall a. Stack a -> a
W.focus Stack KeySym
e) Stack KeySym
e) (Maybe (Stack KeySym) -> Groups KeySym -> Groups KeySym)
-> Maybe (Stack KeySym) -> Groups KeySym -> Groups KeySym
forall a b. (a -> b) -> a -> b
$ (KeySym -> Bool) -> Stack KeySym -> Maybe (Stack KeySym)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (KeySym
xKeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
/=) Stack KeySym
xst
in Groups KeySym -> X (Maybe (Sublayout l KeySym))
fgs (Groups KeySym -> X (Maybe (Sublayout l KeySym)))
-> Groups KeySym -> X (Maybe (Sublayout l KeySym))
forall a b. (a -> b) -> a -> b
$ Groups KeySym -> Groups KeySym
nxsAdd (Groups KeySym -> Groups KeySym) -> Groups KeySym -> Groups KeySym
forall a b. (a -> b) -> a -> b
$ KeySym -> Stack KeySym -> Groups KeySym -> Groups KeySym
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert KeySym
x Stack KeySym
zs (Groups KeySym -> Groups KeySym) -> Groups KeySym -> Groups KeySym
forall a b. (a -> b) -> a -> b
$ KeySym -> Groups KeySym -> Groups KeySym
forall k a. Ord k => k -> Map k a -> Map k a
M.delete KeySym
yf Groups KeySym
gs
| Bool
otherwise = (Maybe (Maybe (Sublayout l KeySym)) -> Maybe (Sublayout l KeySym))
-> X (Maybe (Maybe (Sublayout l KeySym)))
-> X (Maybe (Sublayout l KeySym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe (Sublayout l KeySym)) -> Maybe (Sublayout l KeySym)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (Maybe (Maybe (Sublayout l KeySym)))
-> X (Maybe (Sublayout l KeySym)))
-> X (Maybe (Maybe (Sublayout l KeySym)))
-> X (Maybe (Sublayout l KeySym))
forall a b. (a -> b) -> a -> b
$ Maybe (X (Maybe (Sublayout l KeySym)))
-> X (Maybe (Maybe (Sublayout l KeySym)))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Maybe (X (Maybe (Sublayout l KeySym)))
-> X (Maybe (Maybe (Sublayout l KeySym))))
-> Maybe (X (Maybe (Sublayout l KeySym)))
-> X (Maybe (Maybe (Sublayout l KeySym)))
forall a b. (a -> b) -> a -> b
$ LayoutMessages -> X (Maybe (Sublayout l KeySym))
catchLayoutMess (LayoutMessages -> X (Maybe (Sublayout l KeySym)))
-> Maybe LayoutMessages -> Maybe (X (Maybe (Sublayout l KeySym)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
where gs :: Groups KeySym
gs = [(l KeySym, Stack KeySym)] -> Groups KeySym
forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(l KeySym, Stack KeySym)]
sls
fgs :: Groups KeySym -> X (Maybe (Sublayout l KeySym))
fgs gs' :: Groups KeySym
gs' = do
Maybe (Stack KeySym)
st <- X (Maybe (Stack KeySym))
currentStack
Sublayout l KeySym -> Maybe (Sublayout l KeySym)
forall a. a -> Maybe a
Just (Sublayout l KeySym -> Maybe (Sublayout l KeySym))
-> ([(Bool, (l KeySym, Stack KeySym))] -> Sublayout l KeySym)
-> [(Bool, (l KeySym, Stack KeySym))]
-> Maybe (Sublayout l KeySym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Invisible [] (SomeMessage, KeySym)
-> ([Int], l KeySym)
-> [(l KeySym, Stack KeySym)]
-> Sublayout l KeySym
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, KeySym)] -> Invisible [] (SomeMessage, KeySym)
forall (m :: * -> *) a. m a -> Invisible m a
I [(SomeMessage, KeySym)]
ms) ([Int], l KeySym)
defl ([(l KeySym, Stack KeySym)] -> Sublayout l KeySym)
-> ([(Bool, (l KeySym, Stack KeySym))]
-> [(l KeySym, Stack KeySym)])
-> [(Bool, (l KeySym, Stack KeySym))]
-> Sublayout l KeySym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, (l KeySym, Stack KeySym)) -> (l KeySym, Stack KeySym))
-> [(Bool, (l KeySym, Stack KeySym))] -> [(l KeySym, Stack KeySym)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, (l KeySym, Stack KeySym)) -> (l KeySym, Stack KeySym)
forall a b. (a, b) -> b
snd ([(Bool, (l KeySym, Stack KeySym))] -> Maybe (Sublayout l KeySym))
-> X [(Bool, (l KeySym, Stack KeySym))]
-> X (Maybe (Sublayout l KeySym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Int], l KeySym)
-> Maybe (Stack KeySym)
-> Groups KeySym
-> [(l KeySym, Stack KeySym)]
-> X [(Bool, (l KeySym, Stack KeySym))]
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 KeySym)
defl Maybe (Stack KeySym)
st Groups KeySym
gs' [(l KeySym, Stack KeySym)]
sls
findGroup :: KeySym -> Maybe (Stack KeySym)
findGroup z :: KeySym
z = Maybe (Stack KeySym)
-> Maybe (Stack KeySym) -> Maybe (Stack KeySym)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (KeySym -> Groups KeySym -> Maybe (Stack KeySym)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeySym
z Groups KeySym
gs) (Maybe (Stack KeySym) -> Maybe (Stack KeySym))
-> Maybe (Stack KeySym) -> Maybe (Stack KeySym)
forall a b. (a -> b) -> a -> b
$ [Stack KeySym] -> Maybe (Stack KeySym)
forall a. [a] -> Maybe a
listToMaybe
([Stack KeySym] -> Maybe (Stack KeySym))
-> [Stack KeySym] -> Maybe (Stack KeySym)
forall a b. (a -> b) -> a -> b
$ Groups KeySym -> [Stack KeySym]
forall k a. Map k a -> [a]
M.elems (Groups KeySym -> [Stack KeySym])
-> Groups KeySym -> [Stack KeySym]
forall a b. (a -> b) -> a -> b
$ (Stack KeySym -> Bool) -> Groups KeySym -> Groups KeySym
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter ((KeySym
z KeySym -> [KeySym] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([KeySym] -> Bool)
-> (Stack KeySym -> [KeySym]) -> Stack KeySym -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack KeySym -> [KeySym]
forall a. Stack a -> [a]
W.integrate) Groups KeySym
gs
catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l KeySym))
catchLayoutMess x :: LayoutMessages
x = do
let m' :: LayoutMessages
m' = LayoutMessages
x LayoutMessages -> LayoutMessages -> LayoutMessages
forall a. a -> a -> a
`asTypeOf` (LayoutMessages
forall a. HasCallStack => a
undefined :: LayoutMessages)
[(SomeMessage, KeySym)]
ms' <- [SomeMessage] -> [KeySym] -> [(SomeMessage, KeySym)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SomeMessage -> [SomeMessage]
forall a. a -> [a]
repeat (SomeMessage -> [SomeMessage]) -> SomeMessage -> [SomeMessage]
forall a b. (a -> b) -> a -> b
$ LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
m') ([KeySym] -> [(SomeMessage, KeySym)])
-> (Maybe (Stack KeySym) -> [KeySym])
-> Maybe (Stack KeySym)
-> [(SomeMessage, KeySym)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack KeySym) -> [KeySym]
forall a. Maybe (Stack a) -> [a]
W.integrate'
(Maybe (Stack KeySym) -> [(SomeMessage, KeySym)])
-> X (Maybe (Stack KeySym)) -> X [(SomeMessage, KeySym)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (Maybe (Stack KeySym))
currentStack
Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym)))
-> Maybe (Sublayout l KeySym) -> X (Maybe (Sublayout l KeySym))
forall a b. (a -> b) -> a -> b
$ do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(SomeMessage, KeySym)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SomeMessage, KeySym)]
ms'
Sublayout l KeySym -> Maybe (Sublayout l KeySym)
forall a. a -> Maybe a
Just (Sublayout l KeySym -> Maybe (Sublayout l KeySym))
-> Sublayout l KeySym -> Maybe (Sublayout l KeySym)
forall a b. (a -> b) -> a -> b
$ Invisible [] (SomeMessage, KeySym)
-> ([Int], l KeySym)
-> [(l KeySym, Stack KeySym)]
-> Sublayout l KeySym
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, KeySym)] -> Invisible [] (SomeMessage, KeySym)
forall (m :: * -> *) a. m a -> Invisible m a
I ([(SomeMessage, KeySym)] -> Invisible [] (SomeMessage, KeySym))
-> [(SomeMessage, KeySym)] -> Invisible [] (SomeMessage, KeySym)
forall a b. (a -> b) -> a -> b
$ [(SomeMessage, KeySym)]
ms' [(SomeMessage, KeySym)]
-> [(SomeMessage, KeySym)] -> [(SomeMessage, KeySym)]
forall a. [a] -> [a] -> [a]
++ [(SomeMessage, KeySym)]
ms) ([Int], l KeySym)
defl [(l KeySym, Stack KeySym)]
sls
currentStack :: X (Maybe (W.Stack Window))
currentStack :: X (Maybe (Stack KeySym))
currentStack = (XState -> Maybe (Stack KeySym)) -> X (Maybe (Stack KeySym))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Workspace String (Layout KeySym) KeySym -> Maybe (Stack KeySym)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout KeySym) KeySym -> Maybe (Stack KeySym))
-> (XState -> Workspace String (Layout KeySym) KeySym)
-> XState
-> Maybe (Stack KeySym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace String (Layout KeySym) KeySym
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace String (Layout KeySym) KeySym)
-> (XState
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout KeySym) KeySym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> (XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> XState
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
windowset)
updateGroup :: Ord a => Maybe (W.Stack a) -> Groups a -> Groups a
updateGroup :: Maybe (Stack a) -> Groups a -> Groups a
updateGroup mst :: Maybe (Stack a)
mst gs :: Groups a
gs =
let flatten :: Map k (Stack b) -> [b]
flatten = (Stack b -> [b]) -> [Stack b] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stack b -> [b]
forall a. Stack a -> [a]
W.integrate ([Stack b] -> [b])
-> (Map k (Stack b) -> [Stack b]) -> Map k (Stack b) -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (Stack b) -> [Stack b]
forall k a. Map k a -> [a]
M.elems
news :: [a]
news = Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack a)
mst [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ Groups a -> [a]
forall k b. Map k (Stack b) -> [b]
flatten Groups a
gs
deads :: [a]
deads = Groups a -> [a]
forall k b. Map k (Stack b) -> [b]
flatten Groups a
gs [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack a)
mst
uniNew :: Groups a -> Groups a
uniNew = Groups a -> Groups a -> Groups a
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(a, Stack a)] -> Groups a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, Stack a)] -> Groups a) -> [(a, Stack a)] -> Groups a
forall a b. (a -> b) -> a -> b
$ (a -> (a, Stack a)) -> [a] -> [(a, Stack a)]
forall a b. (a -> b) -> [a] -> [b]
map (\n :: a
n -> (a
n,a -> Stack a
forall a. a -> Stack a
single a
n)) [a]
news)
single :: a -> Stack a
single x :: a
x = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
x [] []
remDead :: Map k (Stack a) -> Groups a
remDead = [(a, Stack a)] -> Groups a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, Stack a)] -> Groups a)
-> (Map k (Stack a) -> [(a, Stack a)])
-> Map k (Stack a)
-> Groups a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> (a, Stack a)) -> [Stack a] -> [(a, Stack a)]
forall a b. (a -> b) -> [a] -> [b]
map (\w :: Stack a
w -> (Stack a -> a
forall a. Stack a -> a
W.focus Stack a
w,Stack a
w))
([Stack a] -> [(a, Stack a)])
-> (Map k (Stack a) -> [Stack a])
-> Map k (Stack a)
-> [(a, Stack a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> Maybe (Stack a)) -> [Stack a] -> [Stack a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((a -> Bool) -> Stack a -> Maybe (Stack a)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
deads)) ([Stack a] -> [Stack a])
-> (Map k (Stack a) -> [Stack a]) -> Map k (Stack a) -> [Stack a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (Stack a) -> [Stack a]
forall k a. Map k a -> [a]
M.elems
followFocus :: Groups a -> Groups a
followFocus hs :: Groups a
hs = Groups a -> Maybe (Groups a) -> Groups a
forall a. a -> Maybe a -> a
fromMaybe Groups a
hs (Maybe (Groups a) -> Groups a) -> Maybe (Groups a) -> Groups a
forall a b. (a -> b) -> a -> b
$ do
a
f' <- Stack a -> a
forall a. Stack a -> a
W.focus (Stack a -> a) -> Maybe (Stack a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (Stack a)
mst
Stack a
xs <- (Stack a -> Bool) -> [Stack a] -> Maybe (Stack a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
f' ([a] -> Bool) -> (Stack a -> [a]) -> Stack a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> [a]
forall a. Stack a -> [a]
W.integrate) ([Stack a] -> Maybe (Stack a)) -> [Stack a] -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ Groups a -> [Stack a]
forall k a. Map k a -> [a]
M.elems Groups a
hs
Stack a
xs' <- (a -> Bool) -> Stack a -> Maybe (Stack a)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
xs) (Stack a -> Maybe (Stack a)) -> Maybe (Stack a) -> Maybe (Stack a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Stack a)
mst
Groups a -> Maybe (Groups a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Groups a -> Maybe (Groups a)) -> Groups a -> Maybe (Groups a)
forall a b. (a -> b) -> a -> b
$ a -> Stack a -> Groups a -> Groups a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
f' Stack a
xs' (Groups a -> Groups a) -> Groups a -> Groups a
forall a b. (a -> b) -> a -> b
$ a -> Groups a -> Groups a
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Stack a -> a
forall a. Stack a -> a
W.focus Stack a
xs) Groups a
hs
in Groups a -> Groups a
forall k. Map k (Stack a) -> Groups a
remDead (Groups a -> Groups a) -> Groups a -> Groups a
forall a b. (a -> b) -> a -> b
$ Groups a -> Groups a
uniNew (Groups a -> Groups a) -> Groups a -> Groups a
forall a b. (a -> b) -> a -> b
$ Groups a -> Groups a
followFocus Groups a
gs
updateWs :: Groups Window -> X ()
updateWs :: Groups KeySym -> X ()
updateWs = (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail))
-> X ()
windowsMaybe ((StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail))
-> X ())
-> (Groups KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail))
-> Groups KeySym
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Groups KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
updateWs'
updateWs' :: Groups Window -> WindowSet -> Maybe WindowSet
updateWs' :: Groups KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
updateWs' gs :: Groups KeySym
gs ws :: StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
ws = do
KeySym
f <- StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Maybe KeySym
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
ws
let w :: [KeySym]
w = StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> [KeySym]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
ws
nes :: [KeySym]
nes = (Stack KeySym -> [KeySym]) -> [Stack KeySym] -> [KeySym]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stack KeySym -> [KeySym]
forall a. Stack a -> [a]
W.integrate ([Stack KeySym] -> [KeySym]) -> [Stack KeySym] -> [KeySym]
forall a b. (a -> b) -> a -> b
$ (KeySym -> Maybe (Stack KeySym)) -> [KeySym] -> [Stack KeySym]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((KeySym -> Groups KeySym -> Maybe (Stack KeySym))
-> Groups KeySym -> KeySym -> Maybe (Stack KeySym)
forall a b c. (a -> b -> c) -> b -> a -> c
flip KeySym -> Groups KeySym -> Maybe (Stack KeySym)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Groups KeySym
gs) [KeySym]
w
ws' :: StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
ws' = KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
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 KeySym
f (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ (KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> [KeySym]
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.insertUp ((KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> [KeySym]
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr KeySym
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.delete' StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
ws [KeySym]
nes) [KeySym]
nes
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> [KeySym]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
ws' [KeySym] -> [KeySym] -> Bool
forall a. Eq a => a -> a -> Bool
/= StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> [KeySym]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
ws
StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
forall (m :: * -> *) a. Monad m => a -> m a
return StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
ws'
focusWindow' :: (Eq a) => a -> W.Stack a -> Maybe (W.Stack a)
focusWindow' :: a -> Stack a -> Maybe (Stack a)
focusWindow' w :: a
w st :: Stack a
st = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a
wa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
st
if Stack a -> a
forall a. Stack a -> a
W.focus Stack a
st a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
w then Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just Stack a
st
else a -> Stack a -> Maybe (Stack a)
forall a. Eq a => a -> Stack a -> Maybe (Stack a)
focusWindow' a
w (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ Stack a -> Stack a
forall a. Stack a -> Stack a
W.focusDown' Stack a
st
windowsMaybe :: (WindowSet -> Maybe WindowSet) -> X ()
windowsMaybe :: (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail))
-> X ()
windowsMaybe f :: StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
f = do
XState
xst <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
ws <- (XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
windowset
let up :: StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> m ()
up fws :: StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
fws = XState -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
xst { windowset :: StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
windowset = StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
fws }
X ()
-> (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> X ())
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> X ()
forall (m :: * -> *).
MonadState XState m =>
StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> m ()
up (Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ())
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Maybe
(StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail)
f StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
ws
unfocused :: W.Stack a -> [a]
unfocused :: Stack a -> [a]
unfocused x :: Stack a
x = Stack a -> [a]
forall a. Stack a -> [a]
W.up Stack a
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Stack 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 :: [(a1, Stack a)] -> Map a (Stack a)
toGroups ws :: [(a1, Stack a)]
ws = [(a, Stack a)] -> Map a (Stack a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, Stack a)] -> Map a (Stack a))
-> ([Stack a] -> [(a, Stack a)]) -> [Stack a] -> Map a (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> (a, Stack a)) -> [Stack a] -> [(a, Stack a)]
forall a b. (a -> b) -> [a] -> [b]
map (Stack a -> a
forall a. Stack a -> a
W.focus (Stack a -> a) -> (Stack a -> Stack a) -> Stack a -> (a, Stack a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Stack a -> Stack a
forall a. a -> a
id) ([Stack a] -> [(a, Stack a)])
-> ([Stack a] -> [Stack a]) -> [Stack a] -> [(a, Stack a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> Stack a -> Bool) -> [Stack a] -> [Stack a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ((a -> a -> Bool) -> (Stack a -> a) -> Stack a -> Stack a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Stack a -> a
forall a. Stack a -> a
W.focus)
([Stack a] -> Map a (Stack a)) -> [Stack a] -> Map a (Stack a)
forall a b. (a -> b) -> a -> b
$ ((a1, Stack a) -> Stack a) -> [(a1, Stack a)] -> [Stack a]
forall a b. (a -> b) -> [a] -> [b]
map (a1, Stack a) -> Stack a
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 :: ([Int], layout a)
-> Maybe (Stack k)
-> Groups k
-> [(layout a, b)]
-> X [(Bool, (layout a, Stack k))]
fromGroups (skips :: [Int]
skips,defl :: layout a
defl) st :: Maybe (Stack k)
st gs :: Groups k
gs sls :: [(layout a, b)]
sls = do
[layout a]
defls <- (Int -> X (layout a)) -> [Int] -> X [layout a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((layout a -> X (layout a)) -> layout a -> [X (layout a)]
forall (m :: * -> *) a. Monad m => (a -> m a) -> a -> [m a]
iterateM layout a -> X (layout a)
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> X (layout a)
nextL layout a
defl [X (layout a)] -> Int -> X (layout a)
forall a. [a] -> Int -> a
!!) [Int]
skips
[(Bool, (layout a, Stack k))] -> X [(Bool, (layout a, Stack k))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Bool, (layout a, Stack k))] -> X [(Bool, (layout a, Stack k))])
-> [(Bool, (layout a, Stack k))] -> X [(Bool, (layout a, Stack k))]
forall a b. (a -> b) -> a -> b
$ layout a
-> [layout a]
-> Maybe (Stack k)
-> Groups k
-> [layout a]
-> [(Bool, (layout a, Stack k))]
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 (((layout a, b) -> layout a) -> [(layout a, b)] -> [layout a]
forall a b. (a -> b) -> [a] -> [b]
map (layout a, b) -> layout a
forall a b. (a, b) -> a
fst [(layout a, b)]
sls)
where nextL :: layout a -> X (layout a)
nextL l :: layout a
l = layout a -> Maybe (layout a) -> layout a
forall a. a -> Maybe a -> a
fromMaybe layout a
l (Maybe (layout a) -> layout a)
-> X (Maybe (layout a)) -> X (layout a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> layout a -> SomeMessage -> X (Maybe (layout a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage layout a
l (ChangeLayout -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage ChangeLayout
NextLayout)
iterateM :: (a -> m a) -> a -> [m a]
iterateM f :: a -> m a
f = (m a -> m a) -> m a -> [m a]
forall a. (a -> a) -> a -> [a]
iterate (m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
f) (m a -> [m a]) -> (a -> m a) -> a -> [m a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
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' :: a
-> [a]
-> Maybe (Stack k)
-> Groups k
-> [a]
-> [(Bool, (a, Stack k))]
fromGroups' defl :: a
defl defls :: [a]
defls st :: Maybe (Stack k)
st gs :: Groups k
gs sls :: [a]
sls =
[ (Bool
isNew,(a, Stack k) -> (Maybe a, Maybe (Stack k)) -> (a, Stack k)
forall a b. (a, b) -> (Maybe a, Maybe b) -> (a, b)
fromMaybe2 (a
dl, k -> Stack k
forall a. a -> Stack a
single k
w) (Maybe a
l, k -> Groups k -> Maybe (Stack k)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
w Groups k
gs))
| Maybe a
l <- (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
sls [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
forall a. Maybe a
Nothing, let isNew :: Bool
isNew = Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
l
| a
dl <- [a]
defls [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> [a]
forall a. a -> [a]
repeat a
defl
| k
w <- Maybe (Stack k) -> [k]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack k) -> [k]) -> Maybe (Stack k) -> [k]
forall a b. (a -> b) -> a -> b
$ (k -> Bool) -> Stack k -> Maybe (Stack k)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (k -> [k] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [k]
unfocs) (Stack k -> Maybe (Stack k)) -> Maybe (Stack k) -> Maybe (Stack k)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Stack k)
st ]
where unfocs :: [k]
unfocs = Stack k -> [k]
forall a. Stack a -> [a]
unfocused (Stack k -> [k]) -> [Stack k] -> [k]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Groups k -> [Stack k]
forall k a. Map k a -> [a]
M.elems Groups k
gs
single :: a -> Stack a
single w :: a
w = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
w [] []
fromMaybe2 :: (a, b) -> (Maybe a, Maybe b) -> (a, b)
fromMaybe2 (a :: a
a,b :: b
b) (x :: Maybe a
x,y :: Maybe b
y) = (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
a Maybe a
x, b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
b Maybe b
y)
setStack :: Maybe (W.Stack Window) -> X ()
setStack :: Maybe (Stack KeySym) -> X ()
setStack x :: Maybe (Stack KeySym)
x = (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: XState
s -> XState
s { windowset :: StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
windowset = (XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
windowset XState
s)
{ current :: Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
W.current = (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
windowset XState
s)
{ workspace :: Workspace String (Layout KeySym) KeySym
W.workspace = (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace String (Layout KeySym) KeySym
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace String (Layout KeySym) KeySym)
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace String (Layout KeySym) KeySym
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail)
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ XState
-> StackSet String (Layout KeySym) KeySym ScreenId ScreenDetail
windowset XState
s) { stack :: Maybe (Stack KeySym)
W.stack = Maybe (Stack KeySym)
x }}}})