{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
module XMonad.Layout.TallMastersCombo (
tmsCombineTwoDefault,
tmsCombineTwo,
TMSCombineTwo (..),
RowsOrColumns (..),
(|||),
SwitchOrientation (..),
SwapSubMaster (..),
FocusSubMaster (..), FocusedNextLayout (..), ChangeFocus (..),
ChooseWrapper (..),
swapWindow,
focusWindow,
handleMessages
) where
import XMonad hiding (focus, (|||))
import qualified XMonad.Layout as LL
import XMonad.Layout.Decoration
import XMonad.Layout.Simplest (Simplest (..))
import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust, listToMaybe)
import XMonad.StackSet (Stack (..), Workspace (..), integrate')
import qualified XMonad.StackSet as W
import XMonad.Util.Stack (zipperFocusedAtFirstOf)
newtype RowsOrColumns a = RowsOrColumns { forall a. RowsOrColumns a -> Bool
rowMode :: Bool
} deriving (Int -> RowsOrColumns a -> ShowS
forall a. Int -> RowsOrColumns a -> ShowS
forall a. [RowsOrColumns a] -> ShowS
forall a. RowsOrColumns a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowsOrColumns a] -> ShowS
$cshowList :: forall a. [RowsOrColumns a] -> ShowS
show :: RowsOrColumns a -> String
$cshow :: forall a. RowsOrColumns a -> String
showsPrec :: Int -> RowsOrColumns a -> ShowS
$cshowsPrec :: forall a. Int -> RowsOrColumns a -> ShowS
Show, ReadPrec [RowsOrColumns a]
ReadPrec (RowsOrColumns a)
ReadS [RowsOrColumns a]
forall a. ReadPrec [RowsOrColumns a]
forall a. ReadPrec (RowsOrColumns a)
forall a. Int -> ReadS (RowsOrColumns a)
forall a. ReadS [RowsOrColumns a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RowsOrColumns a]
$creadListPrec :: forall a. ReadPrec [RowsOrColumns a]
readPrec :: ReadPrec (RowsOrColumns a)
$creadPrec :: forall a. ReadPrec (RowsOrColumns a)
readList :: ReadS [RowsOrColumns a]
$creadList :: forall a. ReadS [RowsOrColumns a]
readsPrec :: Int -> ReadS (RowsOrColumns a)
$creadsPrec :: forall a. Int -> ReadS (RowsOrColumns a)
Read)
instance LayoutClass RowsOrColumns a where
description :: RowsOrColumns a -> String
description (RowsOrColumns Bool
rows) =
if Bool
rows then String
"Rows" else String
"Columns"
pureLayout :: RowsOrColumns a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (RowsOrColumns Bool
rows) Rectangle
r Stack a
s = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rs
where ws :: [a]
ws = forall a. Stack a -> [a]
W.integrate Stack a
s
len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
rs :: [Rectangle]
rs = if Bool
rows
then Int -> Rectangle -> [Rectangle]
splitVertically Int
len Rectangle
r
else Int -> Rectangle -> [Rectangle]
splitHorizontally Int
len Rectangle
r
pureMessage :: RowsOrColumns a -> SomeMessage -> Maybe (RowsOrColumns a)
pureMessage RowsOrColumns{} SomeMessage
m
| Just Orientation
Row <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bool -> RowsOrColumns a
RowsOrColumns Bool
True
| Just Orientation
Col <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bool -> RowsOrColumns a
RowsOrColumns Bool
False
| Bool
otherwise = forall a. Maybe a
Nothing
data TMSCombineTwo l1 l2 a =
TMSCombineTwo { forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> [a]
focusLst :: [a]
, forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> [a]
ws1 :: [a]
, forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> [a]
ws2 :: [a]
, forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> Bool
rowMod :: Bool
, forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> Int
nMaster :: !Int
, forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> Rational
rationInc :: !Rational
, forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> Rational
tallComboRatio :: !Rational
, forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> l1 a
layoutFst :: l1 a
, forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> l2 a
layoutSnd :: l2 a
}
deriving (Int -> TMSCombineTwo l1 l2 a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
Int -> TMSCombineTwo l1 l2 a -> ShowS
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
[TMSCombineTwo l1 l2 a] -> ShowS
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
TMSCombineTwo l1 l2 a -> String
showList :: [TMSCombineTwo l1 l2 a] -> ShowS
$cshowList :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
[TMSCombineTwo l1 l2 a] -> ShowS
show :: TMSCombineTwo l1 l2 a -> String
$cshow :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
TMSCombineTwo l1 l2 a -> String
showsPrec :: Int -> TMSCombineTwo l1 l2 a -> ShowS
$cshowsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
Int -> TMSCombineTwo l1 l2 a -> ShowS
Show, ReadPrec [TMSCombineTwo l1 l2 a]
ReadPrec (TMSCombineTwo l1 l2 a)
ReadS [TMSCombineTwo l1 l2 a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadPrec [TMSCombineTwo l1 l2 a]
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadPrec (TMSCombineTwo l1 l2 a)
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (TMSCombineTwo l1 l2 a)
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadS [TMSCombineTwo l1 l2 a]
readListPrec :: ReadPrec [TMSCombineTwo l1 l2 a]
$creadListPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadPrec [TMSCombineTwo l1 l2 a]
readPrec :: ReadPrec (TMSCombineTwo l1 l2 a)
$creadPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadPrec (TMSCombineTwo l1 l2 a)
readList :: ReadS [TMSCombineTwo l1 l2 a]
$creadList :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadS [TMSCombineTwo l1 l2 a]
readsPrec :: Int -> ReadS (TMSCombineTwo l1 l2 a)
$creadsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (TMSCombineTwo l1 l2 a)
Read)
tmsCombineTwoDefault :: (LayoutClass l1 Window, LayoutClass l2 Window) =>
l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window
tmsCombineTwoDefault :: forall (l1 :: * -> *) (l2 :: * -> *).
(LayoutClass l1 Window, LayoutClass l2 Window) =>
l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window
tmsCombineTwoDefault = forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [] [] [] Bool
True Int
1 (Rational
3forall a. Fractional a => a -> a -> a
/Rational
100) (Rational
1forall a. Fractional a => a -> a -> a
/Rational
2)
tmsCombineTwo :: (LayoutClass l1 Window, LayoutClass l2 Window) =>
Bool -> Int -> Rational -> Rational -> l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window
tmsCombineTwo :: forall (l1 :: * -> *) (l2 :: * -> *).
(LayoutClass l1 Window, LayoutClass l2 Window) =>
Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
tmsCombineTwo = forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [] [] []
data Orientation = Row | Col deriving (ReadPrec [Orientation]
ReadPrec Orientation
Int -> ReadS Orientation
ReadS [Orientation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Orientation]
$creadListPrec :: ReadPrec [Orientation]
readPrec :: ReadPrec Orientation
$creadPrec :: ReadPrec Orientation
readList :: ReadS [Orientation]
$creadList :: ReadS [Orientation]
readsPrec :: Int -> ReadS Orientation
$creadsPrec :: Int -> ReadS Orientation
Read, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> Orientation -> ShowS
Show)
instance Message Orientation
data SwitchOrientation = SwitchOrientation deriving (ReadPrec [SwitchOrientation]
ReadPrec SwitchOrientation
Int -> ReadS SwitchOrientation
ReadS [SwitchOrientation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwitchOrientation]
$creadListPrec :: ReadPrec [SwitchOrientation]
readPrec :: ReadPrec SwitchOrientation
$creadPrec :: ReadPrec SwitchOrientation
readList :: ReadS [SwitchOrientation]
$creadList :: ReadS [SwitchOrientation]
readsPrec :: Int -> ReadS SwitchOrientation
$creadsPrec :: Int -> ReadS SwitchOrientation
Read, Int -> SwitchOrientation -> ShowS
[SwitchOrientation] -> ShowS
SwitchOrientation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwitchOrientation] -> ShowS
$cshowList :: [SwitchOrientation] -> ShowS
show :: SwitchOrientation -> String
$cshow :: SwitchOrientation -> String
showsPrec :: Int -> SwitchOrientation -> ShowS
$cshowsPrec :: Int -> SwitchOrientation -> ShowS
Show)
instance Message SwitchOrientation
data SwapSubMaster = SwapSubMaster deriving (ReadPrec [SwapSubMaster]
ReadPrec SwapSubMaster
Int -> ReadS SwapSubMaster
ReadS [SwapSubMaster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwapSubMaster]
$creadListPrec :: ReadPrec [SwapSubMaster]
readPrec :: ReadPrec SwapSubMaster
$creadPrec :: ReadPrec SwapSubMaster
readList :: ReadS [SwapSubMaster]
$creadList :: ReadS [SwapSubMaster]
readsPrec :: Int -> ReadS SwapSubMaster
$creadsPrec :: Int -> ReadS SwapSubMaster
Read, Int -> SwapSubMaster -> ShowS
[SwapSubMaster] -> ShowS
SwapSubMaster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwapSubMaster] -> ShowS
$cshowList :: [SwapSubMaster] -> ShowS
show :: SwapSubMaster -> String
$cshow :: SwapSubMaster -> String
showsPrec :: Int -> SwapSubMaster -> ShowS
$cshowsPrec :: Int -> SwapSubMaster -> ShowS
Show)
instance Message SwapSubMaster
data FocusSubMaster = FocusSubMaster deriving (ReadPrec [FocusSubMaster]
ReadPrec FocusSubMaster
Int -> ReadS FocusSubMaster
ReadS [FocusSubMaster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FocusSubMaster]
$creadListPrec :: ReadPrec [FocusSubMaster]
readPrec :: ReadPrec FocusSubMaster
$creadPrec :: ReadPrec FocusSubMaster
readList :: ReadS [FocusSubMaster]
$creadList :: ReadS [FocusSubMaster]
readsPrec :: Int -> ReadS FocusSubMaster
$creadsPrec :: Int -> ReadS FocusSubMaster
Read, Int -> FocusSubMaster -> ShowS
[FocusSubMaster] -> ShowS
FocusSubMaster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocusSubMaster] -> ShowS
$cshowList :: [FocusSubMaster] -> ShowS
show :: FocusSubMaster -> String
$cshow :: FocusSubMaster -> String
showsPrec :: Int -> FocusSubMaster -> ShowS
$cshowsPrec :: Int -> FocusSubMaster -> ShowS
Show)
instance Message FocusSubMaster
data FocusedNextLayout = FocusedNextLayout deriving (ReadPrec [FocusedNextLayout]
ReadPrec FocusedNextLayout
Int -> ReadS FocusedNextLayout
ReadS [FocusedNextLayout]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FocusedNextLayout]
$creadListPrec :: ReadPrec [FocusedNextLayout]
readPrec :: ReadPrec FocusedNextLayout
$creadPrec :: ReadPrec FocusedNextLayout
readList :: ReadS [FocusedNextLayout]
$creadList :: ReadS [FocusedNextLayout]
readsPrec :: Int -> ReadS FocusedNextLayout
$creadsPrec :: Int -> ReadS FocusedNextLayout
Read, Int -> FocusedNextLayout -> ShowS
[FocusedNextLayout] -> ShowS
FocusedNextLayout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocusedNextLayout] -> ShowS
$cshowList :: [FocusedNextLayout] -> ShowS
show :: FocusedNextLayout -> String
$cshow :: FocusedNextLayout -> String
showsPrec :: Int -> FocusedNextLayout -> ShowS
$cshowsPrec :: Int -> FocusedNextLayout -> ShowS
Show)
instance Message FocusedNextLayout
data ChangeFocus = NextFocus | PrevFocus deriving (ReadPrec [ChangeFocus]
ReadPrec ChangeFocus
Int -> ReadS ChangeFocus
ReadS [ChangeFocus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangeFocus]
$creadListPrec :: ReadPrec [ChangeFocus]
readPrec :: ReadPrec ChangeFocus
$creadPrec :: ReadPrec ChangeFocus
readList :: ReadS [ChangeFocus]
$creadList :: ReadS [ChangeFocus]
readsPrec :: Int -> ReadS ChangeFocus
$creadsPrec :: Int -> ReadS ChangeFocus
Read, Int -> ChangeFocus -> ShowS
[ChangeFocus] -> ShowS
ChangeFocus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeFocus] -> ShowS
$cshowList :: [ChangeFocus] -> ShowS
show :: ChangeFocus -> String
$cshow :: ChangeFocus -> String
showsPrec :: Int -> ChangeFocus -> ShowS
$cshowsPrec :: Int -> ChangeFocus -> ShowS
Show)
instance Message ChangeFocus
instance (GetFocused l1 Window, GetFocused l2 Window) => LayoutClass (TMSCombineTwo l1 l2) Window where
description :: TMSCombineTwo l1 l2 Window -> String
description TMSCombineTwo l1 l2 Window
_ = String
"TallMasters"
runLayout :: Workspace String (TMSCombineTwo l1 l2 Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (TMSCombineTwo l1 l2 Window))
runLayout (Workspace String
wid (TMSCombineTwo [Window]
f [Window]
_ [Window]
_ Bool
vsp Int
nmaster Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2) Maybe (Stack Window)
s) Rectangle
r =
let (Maybe (Stack Window)
s1,Maybe (Stack Window)
s2,Rational
frac',[Window]
slst1,[Window]
slst2) = forall a.
Eq a =>
[a]
-> Int
-> Rational
-> Maybe (Stack a)
-> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])
splitStack [Window]
f Int
nmaster Rational
frac Maybe (Stack Window)
s
(Rectangle
r1, Rectangle
r2) = if Bool
vsp
then forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
frac' Rectangle
r
else forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy Rational
frac' Rectangle
r
in
do
([(Window, Rectangle)]
ws , Maybe (l1 Window)
ml ) <- 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
Workspace String
wid l1 Window
layout1 Maybe (Stack Window)
s1) Rectangle
r1
([(Window, Rectangle)]
ws', Maybe (l2 Window)
ml') <- 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
Workspace String
wid l2 Window
layout2 Maybe (Stack Window)
s2) Rectangle
r2
let newlayout1 :: l1 Window
newlayout1 = forall a. a -> Maybe a -> a
fromMaybe l1 Window
layout1 Maybe (l1 Window)
ml
newlayout2 :: l2 Window
newlayout2 = forall a. a -> Maybe a -> a
fromMaybe l2 Window
layout2 Maybe (l2 Window)
ml'
([Window]
f1, String
_) = forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused l1 Window
newlayout1 Maybe (Stack Window)
s1
([Window]
f2, String
_) = forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused l2 Window
newlayout2 Maybe (Stack Window)
s2
fnew :: [Window]
fnew = [Window]
f1 forall a. [a] -> [a] -> [a]
++ [Window]
f2
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
wsforall a. [a] -> [a] -> [a]
++[(Window, Rectangle)]
ws', forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
fnew [Window]
slst1 [Window]
slst2 Bool
vsp Int
nmaster Rational
delta Rational
frac l1 Window
newlayout1 l2 Window
newlayout2)
handleMessage :: TMSCombineTwo l1 l2 Window
-> SomeMessage -> X (Maybe (TMSCombineTwo l1 l2 Window))
handleMessage i :: TMSCombineTwo l1 l2 Window
i@(TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 Bool
vsp Int
nmaster Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2) SomeMessage
m
| Just Resize
Shrink <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 Bool
vsp Int
nmaster Rational
delta (forall a. Ord a => a -> a -> a
max Rational
0 forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
-Rational
delta) l1 Window
layout1 l2 Window
layout2
| Just Resize
Expand <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 Bool
vsp Int
nmaster Rational
delta (forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
+Rational
delta) l1 Window
layout1 l2 Window
layout2
| Just (IncMasterN Int
d) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
let w :: [Window]
w = [Window]
w1forall a. [a] -> [a] -> [a]
++[Window]
w2
nmasterNew :: Int
nmasterNew = forall a. Ord a => a -> a -> a
min (forall a. Ord a => a -> a -> a
max Int
0 (Int
nmasterforall a. Num a => a -> a -> a
+Int
d)) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
w)
([Window]
w1',[Window]
w2') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
nmasterNew [Window]
w
in forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1' [Window]
w2' Bool
vsp Int
nmasterNew Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2
| Just SwitchOrientation
SwitchOrientation <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
let m1 :: SomeMessage
m1 = if Bool
vsp then forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col else forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row
in
do Maybe (l1 Window)
mlayout1 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 SomeMessage
m1
Maybe (l2 Window)
mlayout2 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 SomeMessage
m1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 Window)
mlayout1 Maybe (l2 Window)
mlayout2 (forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 (Bool -> Bool
not Bool
vsp) Int
nmaster Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2) Bool
True
| Just SwapSubMaster
SwapSubMaster <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
let subMaster :: Maybe Window
subMaster = forall a. [a] -> Maybe a
listToMaybe [Window]
w2
in case Maybe Window
subMaster of
Just Window
mw -> do (WindowSet -> WindowSet) -> X ()
windows 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 -> b
$ forall a. Eq a => a -> Stack a -> Stack a
swapWindow Window
mw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe Window
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just FocusSubMaster
FocusSubMaster <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
let subMaster :: Maybe Window
subMaster = forall a. [a] -> Maybe a
listToMaybe [Window]
w2
in case Maybe Window
subMaster of
Just Window
mw -> do (WindowSet -> WindowSet) -> X ()
windows 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 -> b
$ forall a. Eq a => a -> Stack a -> Stack a
focusWindow Window
mw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe Window
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just ChangeFocus
NextFocus <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
do
Maybe (Stack Window)
mst <- 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)
let nextw :: Maybe Window
nextw = forall a. Eq a => [a] -> Maybe (Stack a) -> Bool -> Maybe a
adjFocus [Window]
f Maybe (Stack Window)
mst Bool
True
case Maybe Window
nextw of Maybe Window
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just Window
w -> do (WindowSet -> WindowSet) -> X ()
windows 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 -> b
$ forall a. Eq a => a -> Stack a -> Stack a
focusWindow Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just ChangeFocus
PrevFocus <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
do
Maybe (Stack Window)
mst <- 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)
let prevw :: Maybe Window
prevw = forall a. Eq a => [a] -> Maybe (Stack a) -> Bool -> Maybe a
adjFocus [Window]
f Maybe (Stack Window)
mst Bool
False
case Maybe Window
prevw of Maybe Window
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just Window
w -> do (WindowSet -> WindowSet) -> X ()
windows 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 -> b
$ forall a. Eq a => a -> Stack a -> Stack a
focusWindow Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just Orientation
Row <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
do Maybe (l1 Window)
mlayout1 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 (forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col)
Maybe (l2 Window)
mlayout2 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 (forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 Window)
mlayout1 Maybe (l2 Window)
mlayout2 (forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 Bool
False Int
nmaster Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2) Bool
True
| Just Orientation
Col <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
do Maybe (l1 Window)
mlayout1 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 (forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row)
Maybe (l2 Window)
mlayout2 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 (forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 Window)
mlayout1 Maybe (l2 Window)
mlayout2 (forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 Bool
True Int
nmaster Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2) Bool
True
| Just FocusedNextLayout
FocusedNextLayout <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
do
Maybe (Stack Window)
mst <- 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)
let focId :: Int
focId = forall a. Eq a => Maybe (Stack a) -> [a] -> [a] -> Int
findFocused Maybe (Stack Window)
mst [Window]
w1 [Window]
w2
m1 :: SomeMessage
m1 = if Bool
vsp then forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row else forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col
if Int
focId forall a. Eq a => a -> a -> Bool
== Int
1
then do
Maybe (l1 Window)
mlay1 <- forall (l :: * -> *) a.
LayoutClass l a =>
l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages l1 Window
layout1 [forall a. Message a => a -> SomeMessage
SomeMessage ChangeLayout
NextLayout, SomeMessage
m1]
let mlay2 :: Maybe a
mlay2 = forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 Window)
mlay1 forall a. Maybe a
mlay2 TMSCombineTwo l1 l2 Window
i Bool
True
else do
let mlay1 :: Maybe a
mlay1 = forall a. Maybe a
Nothing
Maybe (l2 Window)
mlay2 <- forall (l :: * -> *) a.
LayoutClass l a =>
l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages l2 Window
layout2 [forall a. Message a => a -> SomeMessage
SomeMessage ChangeLayout
NextLayout, SomeMessage
m1]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts forall a. Maybe a
mlay1 Maybe (l2 Window)
mlay2 TMSCombineTwo l1 l2 Window
i Bool
True
| Bool
otherwise =
do
Maybe (l1 Window)
mlayout1 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 SomeMessage
m
Maybe (l2 Window)
mlayout2 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 SomeMessage
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 Window)
mlayout1 Maybe (l2 Window)
mlayout2 TMSCombineTwo l1 l2 Window
i Bool
False
swapWindow :: (Eq a) => a -> Stack a -> Stack a
swapWindow :: forall a. Eq a => a -> Stack a -> Stack a
swapWindow a
w (Stack a
foc [a]
upLst [a]
downLst)
| ([a]
us, a
d:[a]
ds) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== a
w) [a]
downLst = forall a. a -> [a] -> [a] -> Stack a
Stack a
foc (forall a. [a] -> [a]
reverse [a]
us forall a. [a] -> [a] -> [a]
++ a
d forall a. a -> [a] -> [a]
: [a]
upLst) [a]
ds
| ([a]
ds, a
u:[a]
us) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== a
w) [a]
upLst = forall a. a -> [a] -> [a] -> Stack a
Stack a
foc [a]
us (forall a. [a] -> [a]
reverse [a]
ds forall a. [a] -> [a] -> [a]
++ a
u forall a. a -> [a] -> [a]
: [a]
downLst)
| Bool
otherwise = forall a. a -> [a] -> [a] -> Stack a
Stack a
foc [a]
upLst [a]
downLst
focusWindow :: (Eq a) => a -> Stack a -> Stack a
focusWindow :: forall a. Eq a => a -> Stack a -> Stack a
focusWindow a
w Stack a
s =
if a
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Stack a -> [a]
up Stack a
s
then forall a. Eq a => a -> Stack a -> Stack a
focusSubMasterU a
w Stack a
s
else forall a. Eq a => a -> Stack a -> Stack a
focusSubMasterD a
w Stack a
s
where
focusSubMasterU :: t -> Stack t -> Stack t
focusSubMasterU t
win i :: Stack t
i@(Stack t
foc (t
l:[t]
ls) [t]
rs)
| t
foc forall a. Eq a => a -> a -> Bool
== t
win = Stack t
i
| t
l forall a. Eq a => a -> a -> Bool
== t
win = Stack t
news
| Bool
otherwise = t -> Stack t -> Stack t
focusSubMasterU t
win Stack t
news
where
news :: Stack t
news = forall a. a -> [a] -> [a] -> Stack a
Stack t
l [t]
ls (t
foc forall a. a -> [a] -> [a]
: [t]
rs)
focusSubMasterU t
_ (Stack t
foc [] [t]
rs) =
forall a. a -> [a] -> [a] -> Stack a
Stack t
foc [] [t]
rs
focusSubMasterD :: t -> Stack t -> Stack t
focusSubMasterD t
win i :: Stack t
i@(Stack t
foc [t]
ls (t
r:[t]
rs))
| t
foc forall a. Eq a => a -> a -> Bool
== t
win = Stack t
i
| t
r forall a. Eq a => a -> a -> Bool
== t
win = Stack t
news
| Bool
otherwise = t -> Stack t -> Stack t
focusSubMasterD t
win Stack t
news
where
news :: Stack t
news = forall a. a -> [a] -> [a] -> Stack a
Stack t
r (t
foc forall a. a -> [a] -> [a]
: [t]
ls) [t]
rs
focusSubMasterD t
_ (Stack t
foc [t]
ls []) =
forall a. a -> [a] -> [a] -> Stack a
Stack t
foc [t]
ls []
mergeSubLayouts
:: Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts :: forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 a)
ml1 Maybe (l2 a)
ml2 (TMSCombineTwo [a]
f [a]
w1 [a]
w2 Bool
vsp Int
nmaster Rational
delta Rational
frac l1 a
l1 l2 a
l2) Bool
alwaysReturn
| Bool
alwaysReturn = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [a]
f [a]
w1 [a]
w2 Bool
vsp Int
nmaster Rational
delta Rational
frac (forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 Maybe (l1 a)
ml1) (forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 Maybe (l2 a)
ml2)
| forall a. Maybe a -> Bool
isJust Maybe (l1 a)
ml1 Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (l2 a)
ml2 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [a]
f [a]
w1 [a]
w2 Bool
vsp Int
nmaster Rational
delta Rational
frac (forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 Maybe (l1 a)
ml1) (forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 Maybe (l2 a)
ml2)
| Bool
otherwise = forall a. Maybe a
Nothing
findFocused :: (Eq a) => Maybe (Stack a) -> [a] -> [a] -> Int
findFocused :: forall a. Eq a => Maybe (Stack a) -> [a] -> [a] -> Int
findFocused Maybe (Stack a)
mst [a]
w1 [a]
w2 =
case Maybe (Stack a)
mst of
Maybe (Stack a)
Nothing -> Int
1
Just Stack a
st -> if a
foc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
w1
then Int
1
else if a
foc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
w2
then Int
2
else Int
1
where foc :: a
foc = forall a. Stack a -> a
W.focus Stack a
st
handleMessages :: (LayoutClass l a) => l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages l a
l = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (l :: * -> *) a.
LayoutClass l a =>
Maybe (l a) -> SomeMessage -> X (Maybe (l a))
handleMaybeMsg (forall a. a -> Maybe a
Just l a
l)
handleMaybeMsg :: (LayoutClass l a) => Maybe (l a) -> SomeMessage -> X (Maybe (l a))
handleMaybeMsg :: forall (l :: * -> *) a.
LayoutClass l a =>
Maybe (l a) -> SomeMessage -> X (Maybe (l a))
handleMaybeMsg Maybe (l a)
ml SomeMessage
m = case Maybe (l a)
ml of Just l a
l -> do
Maybe (l a)
res <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Maybe a -> Maybe a
elseOr (forall a. a -> Maybe a
Just l a
l) Maybe (l a)
res
Maybe (l a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
splitStack :: (Eq a) => [a] -> Int -> Rational -> Maybe (Stack a) -> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])
splitStack :: forall a.
Eq a =>
[a]
-> Int
-> Rational
-> Maybe (Stack a)
-> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])
splitStack [a]
f Int
nmaster Rational
frac Maybe (Stack a)
s =
let slst :: [a]
slst = forall a. Maybe (Stack a) -> [a]
integrate' Maybe (Stack a)
s
f' :: [a]
f' = case Maybe (Stack a)
s of (Just Stack a
s') -> forall a. Stack a -> a
focus Stack a
s'forall a. a -> [a] -> [a]
:forall a. Eq a => a -> [a] -> [a]
delete (forall a. Stack a -> a
focus Stack a
s') [a]
f
Maybe (Stack a)
Nothing -> [a]
f
snum :: Int
snum = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
slst
([a]
slst1, [a]
slst2) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
nmaster [a]
slst
s0 :: Maybe (Stack a)
s0 = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [a]
f' [a]
slst
s1' :: Maybe (Stack a)
s1' = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [a]
f' [a]
slst1
s2' :: Maybe (Stack a)
s2' = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [a]
f' [a]
slst2
(Maybe (Stack a)
s1,Maybe (Stack a)
s2,Rational
frac') | Int
nmaster forall a. Eq a => a -> a -> Bool
== Int
0 = (forall a. Maybe a
Nothing,Maybe (Stack a)
s0,Rational
0)
| Int
nmaster forall a. Ord a => a -> a -> Bool
>= Int
snum = (Maybe (Stack a)
s0,forall a. Maybe a
Nothing,Rational
1)
| Bool
otherwise = (Maybe (Stack a)
s1',Maybe (Stack a)
s2',Rational
frac)
in (Maybe (Stack a)
s1,Maybe (Stack a)
s2,Rational
frac',[a]
slst1,[a]
slst2)
type Next = Bool
adjFocus :: (Eq a) => [a] -> Maybe (Stack a) -> Next -> Maybe a
adjFocus :: forall a. Eq a => [a] -> Maybe (Stack a) -> Bool -> Maybe a
adjFocus [a]
ws Maybe (Stack a)
ms Bool
next =
case Maybe (Stack a)
ms of Maybe (Stack a)
Nothing -> forall a. Maybe a
Nothing
Just Stack a
s -> let searchLst :: [a]
searchLst = if Bool
next
then forall a. Stack a -> [a]
down Stack a
s forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse (forall a. Stack a -> [a]
up Stack a
s)
else forall a. Stack a -> [a]
up Stack a
s forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse (forall a. Stack a -> [a]
down Stack a
s)
in forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ws) [a]
searchLst
elseOr :: Maybe a -> Maybe a -> Maybe a
elseOr :: forall a. Maybe a -> Maybe a -> Maybe a
elseOr Maybe a
x Maybe a
y = case Maybe a
y of
Just a
_ -> Maybe a
y
Maybe a
Nothing -> Maybe a
x
data LR = L | R deriving (Int -> LR -> ShowS
[LR] -> ShowS
LR -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LR] -> ShowS
$cshowList :: [LR] -> ShowS
show :: LR -> String
$cshow :: LR -> String
showsPrec :: Int -> LR -> ShowS
$cshowsPrec :: Int -> LR -> ShowS
Show, ReadPrec [LR]
ReadPrec LR
Int -> ReadS LR
ReadS [LR]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LR]
$creadListPrec :: ReadPrec [LR]
readPrec :: ReadPrec LR
$creadPrec :: ReadPrec LR
readList :: ReadS [LR]
$creadList :: ReadS [LR]
readsPrec :: Int -> ReadS LR
$creadsPrec :: Int -> ReadS LR
Read, LR -> LR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LR -> LR -> Bool
$c/= :: LR -> LR -> Bool
== :: LR -> LR -> Bool
$c== :: LR -> LR -> Bool
Eq)
data ChooseWrapper l r a = ChooseWrapper LR (l a) (r a) (Choose l r a) deriving (Int -> ChooseWrapper l r a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
Int -> ChooseWrapper l r a -> ShowS
forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
[ChooseWrapper l r a] -> ShowS
forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
ChooseWrapper l r a -> String
showList :: [ChooseWrapper l r a] -> ShowS
$cshowList :: forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
[ChooseWrapper l r a] -> ShowS
show :: ChooseWrapper l r a -> String
$cshow :: forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
ChooseWrapper l r a -> String
showsPrec :: Int -> ChooseWrapper l r a -> ShowS
$cshowsPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
Int -> ChooseWrapper l r a -> ShowS
Show, ReadPrec [ChooseWrapper l r a]
ReadPrec (ChooseWrapper l r a)
ReadS [ChooseWrapper l r a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec [ChooseWrapper l r a]
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec (ChooseWrapper l r a)
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
Int -> ReadS (ChooseWrapper l r a)
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadS [ChooseWrapper l r a]
readListPrec :: ReadPrec [ChooseWrapper l r a]
$creadListPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec [ChooseWrapper l r a]
readPrec :: ReadPrec (ChooseWrapper l r a)
$creadPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec (ChooseWrapper l r a)
readList :: ReadS [ChooseWrapper l r a]
$creadList :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadS [ChooseWrapper l r a]
readsPrec :: Int -> ReadS (ChooseWrapper l r a)
$creadsPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
Int -> ReadS (ChooseWrapper l r a)
Read)
data NextNoWrap = NextNoWrap deriving (NextNoWrap -> NextNoWrap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NextNoWrap -> NextNoWrap -> Bool
$c/= :: NextNoWrap -> NextNoWrap -> Bool
== :: NextNoWrap -> NextNoWrap -> Bool
$c== :: NextNoWrap -> NextNoWrap -> Bool
Eq, Int -> NextNoWrap -> ShowS
[NextNoWrap] -> ShowS
NextNoWrap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NextNoWrap] -> ShowS
$cshowList :: [NextNoWrap] -> ShowS
show :: NextNoWrap -> String
$cshow :: NextNoWrap -> String
showsPrec :: Int -> NextNoWrap -> ShowS
$cshowsPrec :: Int -> NextNoWrap -> ShowS
Show)
instance Message NextNoWrap
handle :: (LayoutClass l a, Message m) => l a -> m -> X (Maybe (l a))
handle :: forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l m
m = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l (forall a. Message a => a -> SomeMessage
SomeMessage m
m)
data End = End | NoEnd
instance (GetFocused l a, GetFocused r a) => LayoutClass (ChooseWrapper l r) a where
description :: ChooseWrapper l r a -> String
description (ChooseWrapper LR
_ l a
_ r a
_ Choose l r a
lr) = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description Choose l r a
lr
runLayout :: Workspace String (ChooseWrapper l r a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (ChooseWrapper l r a))
runLayout (Workspace String
wid (ChooseWrapper LR
d l a
l r a
r Choose l r a
lr) Maybe (Stack a)
s) Rectangle
rec =
do
let (l a
l', r a
r') = case LR
d of LR
L -> (forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused l a
l Maybe (Stack a)
s, r a
r)
LR
R -> (l a
l, forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused r a
r Maybe (Stack a)
s)
([(a, Rectangle)]
ws, Maybe (Choose l r a)
ml0) <- 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
Workspace String
wid Choose l r a
lr Maybe (Stack a)
s) Rectangle
rec
let l1 :: Maybe (ChooseWrapper l r a)
l1 = case Maybe (Choose l r a)
ml0 of Just Choose l r a
l0 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d l a
l' r a
r' Choose l r a
l0
Maybe (Choose l r a)
Nothing -> forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
ws,Maybe (ChooseWrapper l r a)
l1)
handleMessage :: ChooseWrapper l r a
-> SomeMessage -> X (Maybe (ChooseWrapper l r a))
handleMessage c :: ChooseWrapper l r a
c@(ChooseWrapper LR
d l a
l r a
r Choose l r a
lr) SomeMessage
m
| Just ChangeLayout
NextLayout <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
Maybe (Choose l r a)
mlr' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Choose l r a
lr SomeMessage
m
Maybe (ChooseWrapper l r a)
mlrf <- forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle ChooseWrapper l r a
c NextNoWrap
NextNoWrap
Maybe (ChooseWrapper l r a)
fstf <- forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle ChooseWrapper l r a
c ChangeLayout
FirstLayout
let mlf :: Maybe (ChooseWrapper l r a)
mlf = forall a. Maybe a -> Maybe a -> Maybe a
elseOr Maybe (ChooseWrapper l r a)
fstf Maybe (ChooseWrapper l r a)
mlrf
(LR
d',l a
l',r a
r') = case Maybe (ChooseWrapper l r a)
mlf of Just (ChooseWrapper LR
d0 l a
l0 r a
r0 Choose l r a
_) -> (LR
d0,l a
l0,r a
r0)
Maybe (ChooseWrapper l r a)
Nothing -> (LR
d,l a
l,r a
r)
case Maybe (Choose l r a)
mlr' of Just Choose l r a
lrt -> 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 :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d' l a
l' r a
r' Choose l r a
lrt
Maybe (Choose l r a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just NextNoWrap
NextNoWrap <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
Maybe (Choose l r a)
mlr' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Choose l r a
lr SomeMessage
m
(LR
d',l a
l',r a
r', End
end) <-
case LR
d of
LR
L -> do
Maybe (l a)
ml <- forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l NextNoWrap
NextNoWrap
case Maybe (l a)
ml of
Just l a
l0 -> forall (m :: * -> *) a. Monad m => a -> m a
return (LR
L, l a
l0, r a
r, End
NoEnd)
Maybe (l a)
Nothing -> do
Maybe (r a)
mr <- forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle r a
r ChangeLayout
FirstLayout
case Maybe (r a)
mr of
Just r a
r0 -> forall (m :: * -> *) a. Monad m => a -> m a
return (LR
R, l a
l, r a
r0, End
NoEnd)
Maybe (r a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (LR
R, l a
l, r a
r, End
NoEnd)
LR
R -> do
Maybe (r a)
mr <- forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle r a
r NextNoWrap
NextNoWrap
case Maybe (r a)
mr of
Just r a
r0 -> forall (m :: * -> *) a. Monad m => a -> m a
return (LR
R, l a
l, r a
r0, End
NoEnd)
Maybe (r a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (LR
d, l a
l, r a
r, End
End)
case Maybe (Choose l r a)
mlr' of Just Choose l r a
lrt -> 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 :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d' l a
l' r a
r' Choose l r a
lrt
Maybe (Choose l r a)
Nothing ->
case End
end of End
NoEnd -> 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 :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d' l a
l' r a
r' Choose l r a
lr
End
End -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just ChangeLayout
FirstLayout <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
Maybe (Choose l r a)
mlr' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Choose l r a
lr SomeMessage
m
(LR
d',l a
l',r a
r') <- do
Maybe (l a)
ml <- forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l ChangeLayout
FirstLayout
case Maybe (l a)
ml of
Just l a
l0 -> forall (m :: * -> *) a. Monad m => a -> m a
return (LR
L,l a
l0,r a
r)
Maybe (l a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (LR
L,l a
l,r a
r)
case Maybe (Choose l r a)
mlr' of Just Choose l r a
lrt -> 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 :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d' l a
l' r a
r' Choose l r a
lrt
Maybe (Choose l r a)
Nothing -> 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 :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d' l a
l' r a
r' Choose l r a
lr
| Bool
otherwise = do
Maybe (Choose l r a)
mlr' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Choose l r a
lr SomeMessage
m
case Maybe (Choose l r a)
mlr' of Just Choose l r a
lrt -> 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 :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d l a
l r a
r Choose l r a
lrt
Maybe (Choose l r a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
(|||) :: l a -> r a -> ChooseWrapper l r a
||| :: forall (l :: * -> *) a (r :: * -> *).
l a -> r a -> ChooseWrapper l r a
(|||) l a
l r a
r = forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
L l a
l r a
r (l a
l forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
LL.||| r a
r)
class (LayoutClass l a) => GetFocused l a where
getFocused :: l a -> Maybe (Stack a) -> ([a], String)
getFocused l a
_ Maybe (Stack a)
ms =
case Maybe (Stack a)
ms of (Just Stack a
s) -> ([forall a. Stack a -> a
focus Stack a
s], String
"Base")
Maybe (Stack a)
Nothing -> ([], String
"Base")
savFocused :: l a -> Maybe (Stack a) -> l a
savFocused l a
l Maybe (Stack a)
_ = l a
l
instance (GetFocused l Window, GetFocused r Window) => GetFocused (TMSCombineTwo l r) Window where
getFocused :: TMSCombineTwo l r Window
-> Maybe (Stack Window) -> ([Window], String)
getFocused (TMSCombineTwo [Window]
f [Window]
_ [Window]
_ Bool
_ Int
nmaster Rational
_ Rational
frac l Window
lay1 r Window
lay2) Maybe (Stack Window)
s =
let (Maybe (Stack Window)
s1,Maybe (Stack Window)
s2,Rational
_,[Window]
_,[Window]
_) = forall a.
Eq a =>
[a]
-> Int
-> Rational
-> Maybe (Stack a)
-> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])
splitStack [Window]
f Int
nmaster Rational
frac Maybe (Stack Window)
s
([Window]
f1, String
str1) = forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused l Window
lay1 Maybe (Stack Window)
s1
([Window]
f2, String
str2) = forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused r Window
lay2 Maybe (Stack Window)
s2
in ([Window]
f1 forall a. [a] -> [a] -> [a]
++ [Window]
f2, String
"TMS: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Window]
f forall a. [a] -> [a] -> [a]
++ String
"::" forall a. [a] -> [a] -> [a]
++ String
str1 forall a. [a] -> [a] -> [a]
++ String
"--" forall a. [a] -> [a] -> [a]
++ String
str2)
savFocused :: TMSCombineTwo l r Window
-> Maybe (Stack Window) -> TMSCombineTwo l r Window
savFocused i :: TMSCombineTwo l r Window
i@(TMSCombineTwo [Window]
f [Window]
_ [Window]
_ Bool
_ Int
nmaster Rational
_ Rational
frac l Window
lay1 r Window
lay2) Maybe (Stack Window)
s =
let (Maybe (Stack Window)
s1,Maybe (Stack Window)
s2,Rational
_,[Window]
_,[Window]
_) = forall a.
Eq a =>
[a]
-> Int
-> Rational
-> Maybe (Stack a)
-> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])
splitStack [Window]
f Int
nmaster Rational
frac Maybe (Stack Window)
s
([Window]
f', String
_) = forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused TMSCombineTwo l r Window
i Maybe (Stack Window)
s
lay1' :: l Window
lay1' = forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused l Window
lay1 Maybe (Stack Window)
s1
lay2' :: r Window
lay2' = forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused r Window
lay2 Maybe (Stack Window)
s2
in TMSCombineTwo l r Window
i {focusLst :: [Window]
focusLst = [Window]
f', layoutFst :: l Window
layoutFst=l Window
lay1', layoutSnd :: r Window
layoutSnd=r Window
lay2'}
instance (GetFocused l a, GetFocused r a) => GetFocused (ChooseWrapper l r) a where
getFocused :: ChooseWrapper l r a -> Maybe (Stack a) -> ([a], String)
getFocused (ChooseWrapper LR
d l a
l r a
r Choose l r a
_) Maybe (Stack a)
s =
case LR
d of LR
L -> forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused l a
l Maybe (Stack a)
s
LR
R -> forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused r a
r Maybe (Stack a)
s
savFocused :: ChooseWrapper l r a -> Maybe (Stack a) -> ChooseWrapper l r a
savFocused (ChooseWrapper LR
d l a
l r a
r Choose l r a
lr) Maybe (Stack a)
s =
let (l a
l', r a
r') =
case LR
d of LR
L -> (forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused l a
l Maybe (Stack a)
s, r a
r)
LR
R -> (l a
l, forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused r a
r Maybe (Stack a)
s)
in forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d l a
l' r a
r' Choose l r a
lr
instance (Typeable a) => GetFocused Simplest a
instance (Typeable a) => GetFocused RowsOrColumns a
instance (Typeable a) => GetFocused Full a
instance (Typeable a) => GetFocused Tall a
instance (Typeable l, Typeable a, Typeable m, LayoutModifier m a, LayoutClass l a) => GetFocused (ModifiedLayout m l) a