{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.ComboP
-- Description :  Combine multiple layouts and specify where to put new windows.
-- Copyright   :  (c) Konstantin Sobolev <konstantin.sobolev@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Konstantin Sobolev <konstantin.sobolev@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout that combines multiple layouts and allows to specify where to put
-- new windows.
--
-----------------------------------------------------------------------------

module XMonad.Layout.ComboP (
                             -- * Usage
                             -- $usage
                             combineTwoP,
                             CombineTwoP,
                             SwapWindow(..),
                             PartitionWins(..),
                             Property(..)
                            ) where

import XMonad hiding (focus)
import XMonad.Layout.WindowNavigation
import XMonad.Prelude
import XMonad.StackSet ( Workspace (..), Stack(..) )
import qualified XMonad.StackSet as W
import XMonad.Util.Stack (zipperFocusedAtFirstOf)
import XMonad.Util.WindowProperties

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.ComboP
--
-- and add something like
--
-- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText def) (tabbed shrinkText def) (ClassName "Firefox")
--
-- to your layouts. This way all windows with class = \"Firefox\" will always go
-- to the left pane, all others - to the right.
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
--
-- 'combineTwoP' is a simple layout combinator based on 'combineTwo' from Combo, with
-- addition of a 'Property' which tells where to put new windows. Windows mathing
-- the property will go into the first part, all others will go into the second
-- part. It supports @Move@ messages as 'combineTwo' does, but it also introduces
-- 'SwapWindow' message which sends focused window to the other part. It is
-- required because @Move@ commands don't work when one of the parts is empty.
-- To use it, import \"XMonad.Layout.WindowNavigation\", and add the following key
-- bindings (or something similar):
--
-- >    , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
-- >    , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)
-- >    , ((modm .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)
-- >    , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)
-- >    , ((modm .|. controlMask .|. shiftMask, xK_s    ), sendMessage $ SwapWindow)
--
-- For detailed instruction on editing the key binding see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

data SwapWindow =  SwapWindow        -- ^ Swap window between panes
                 | SwapWindowN Int   -- ^ Swap window between panes in the N-th nested ComboP. @SwapWindowN 0@ equals to SwapWindow
                 deriving (ReadPrec [SwapWindow]
ReadPrec SwapWindow
Int -> ReadS SwapWindow
ReadS [SwapWindow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwapWindow]
$creadListPrec :: ReadPrec [SwapWindow]
readPrec :: ReadPrec SwapWindow
$creadPrec :: ReadPrec SwapWindow
readList :: ReadS [SwapWindow]
$creadList :: ReadS [SwapWindow]
readsPrec :: Int -> ReadS SwapWindow
$creadsPrec :: Int -> ReadS SwapWindow
Read, Int -> SwapWindow -> ShowS
[SwapWindow] -> ShowS
SwapWindow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwapWindow] -> ShowS
$cshowList :: [SwapWindow] -> ShowS
show :: SwapWindow -> String
$cshow :: SwapWindow -> String
showsPrec :: Int -> SwapWindow -> ShowS
$cshowsPrec :: Int -> SwapWindow -> ShowS
Show)
instance Message SwapWindow

data PartitionWins = PartitionWins  -- ^ Reset the layout and
                                    -- partition all windows into the
                                    -- correct sub-layout.  Useful for
                                    -- when window properties have
                                    -- changed and you want ComboP to
                                    -- update which layout a window
                                    -- belongs to.
                   deriving (ReadPrec [PartitionWins]
ReadPrec PartitionWins
Int -> ReadS PartitionWins
ReadS [PartitionWins]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PartitionWins]
$creadListPrec :: ReadPrec [PartitionWins]
readPrec :: ReadPrec PartitionWins
$creadPrec :: ReadPrec PartitionWins
readList :: ReadS [PartitionWins]
$creadList :: ReadS [PartitionWins]
readsPrec :: Int -> ReadS PartitionWins
$creadsPrec :: Int -> ReadS PartitionWins
Read, Int -> PartitionWins -> ShowS
[PartitionWins] -> ShowS
PartitionWins -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartitionWins] -> ShowS
$cshowList :: [PartitionWins] -> ShowS
show :: PartitionWins -> String
$cshow :: PartitionWins -> String
showsPrec :: Int -> PartitionWins -> ShowS
$cshowsPrec :: Int -> PartitionWins -> ShowS
Show)
instance Message PartitionWins

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

combineTwoP :: (LayoutClass super(), LayoutClass l1 Window, LayoutClass l2 Window) =>
                super () -> l1 Window -> l2 Window -> Property -> CombineTwoP (super ()) l1 l2 Window
combineTwoP :: forall (super :: * -> *) (l1 :: * -> *) (l2 :: * -> *).
(LayoutClass super (), LayoutClass l1 Window,
 LayoutClass l2 Window) =>
super ()
-> l1 Window
-> l2 Window
-> Property
-> CombineTwoP (super ()) l1 l2 Window
combineTwoP = forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> l
-> l1 a
-> l2 a
-> Property
-> CombineTwoP l l1 l2 a
C2P [] [] []

instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
    LayoutClass (CombineTwoP (l ()) l1 l2) Window where
    doLayout :: CombineTwoP (l ()) l1 l2 Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)],
      Maybe (CombineTwoP (l ()) l1 l2 Window))
doLayout (C2P [Window]
f [Window]
w1 [Window]
w2 l ()
super l1 Window
l1 l2 Window
l2 Property
prop) Rectangle
rinput Stack Window
s =
        let origws :: [Window]
origws = forall a. Stack a -> [a]
W.integrate Stack Window
s           -- passed in windows
            w1c :: [Window]
w1c = [Window]
origws forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Window]
w1      -- current windows in the first pane
            w2c :: [Window]
w2c = [Window]
origws forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Window]
w2      -- current windows in the second pane
            new :: [Window]
new = [Window]
origws forall a. Eq a => [a] -> [a] -> [a]
\\ ([Window]
w1c forall a. [a] -> [a] -> [a]
++ [Window]
w2c)     -- new windows
            superstack :: Maybe (Stack ())
superstack = forall a. a -> Maybe a
Just Stack { focus :: ()
focus=(), up :: [()]
up=[], down :: [()]
down=[()] }
            f' :: [Window]
f' = forall a. Stack a -> a
focus Stack Window
sforall a. a -> [a] -> [a]
:forall a. Eq a => a -> [a] -> [a]
delete (forall a. Stack a -> a
focus Stack Window
s) [Window]
f  -- list of focused windows, contains 2 elements at most
        in do
            [Window]
matching <- Property -> Window -> X Bool
hasProperty Property
prop forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
`filterM` [Window]
new  -- new windows matching predecate
            let w1' :: [Window]
w1' = [Window]
w1c forall a. [a] -> [a] -> [a]
++ [Window]
matching                   -- updated first pane windows
                w2' :: [Window]
w2' = [Window]
w2c forall a. [a] -> [a] -> [a]
++ ([Window]
new forall a. Eq a => [a] -> [a] -> [a]
\\ [Window]
matching)          -- updated second pane windows
                s1 :: Zipper Window
s1 = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [Window]
f' [Window]
w1'      -- first pane stack
                s2 :: Zipper Window
s2 = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [Window]
f' [Window]
w2'      -- second pane stack
            ([((),Rectangle
r1),((),Rectangle
r2)], Maybe (l ())
msuper') <- 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
"" l ()
super Maybe (Stack ())
superstack) Rectangle
rinput
            ([(Window, Rectangle)]
wrs1, Maybe (l1 Window)
ml1') <- 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
"" l1 Window
l1 Zipper Window
s1) Rectangle
r1
            ([(Window, Rectangle)]
wrs2, Maybe (l2 Window)
ml2') <- 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
"" l2 Window
l2 Zipper Window
s2) Rectangle
r2
            forall (m :: * -> *) a. Monad m => a -> m a
return  ([(Window, Rectangle)]
wrs1forall a. [a] -> [a] -> [a]
++[(Window, Rectangle)]
wrs2, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> l
-> l1 a
-> l2 a
-> Property
-> CombineTwoP l l1 l2 a
C2P [Window]
f' [Window]
w1' [Window]
w2' (forall a. a -> Maybe a -> a
fromMaybe l ()
super Maybe (l ())
msuper')
                (forall a. a -> Maybe a -> a
fromMaybe l1 Window
l1 Maybe (l1 Window)
ml1') (forall a. a -> Maybe a -> a
fromMaybe l2 Window
l2 Maybe (l2 Window)
ml2') Property
prop)

    handleMessage :: CombineTwoP (l ()) l1 l2 Window
-> SomeMessage -> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
handleMessage us :: CombineTwoP (l ()) l1 l2 Window
us@(C2P [Window]
f [Window]
ws1 [Window]
ws2 l ()
super l1 Window
l1 l2 Window
l2 Property
prop) SomeMessage
m
        | Just PartitionWins
PartitionWins   <- 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 l (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> l
-> l1 a
-> l2 a
-> Property
-> CombineTwoP l l1 l2 a
C2P [] [] [] l ()
super l1 Window
l1 l2 Window
l2 Property
prop
        | Just SwapWindow
SwapWindow      <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (s :: * -> *) a (l1 :: * -> *) (l2 :: * -> *).
(LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) =>
CombineTwoP (s a) l1 l2 Window
-> X (Maybe (CombineTwoP (s a) l1 l2 Window))
swap CombineTwoP (l ()) l1 l2 Window
us
        | Just (SwapWindowN Int
0) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (s :: * -> *) a (l1 :: * -> *) (l2 :: * -> *).
(LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) =>
CombineTwoP (s a) l1 l2 Window
-> X (Maybe (CombineTwoP (s a) l1 l2 Window))
swap CombineTwoP (l ()) l1 l2 Window
us
        | Just (SwapWindowN Int
n) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (l1 :: * -> *) (l2 :: * -> *) (s :: * -> *) a.
(LayoutClass l1 Window, LayoutClass l2 Window, LayoutClass s a) =>
CombineTwoP (s a) l1 l2 Window
-> SomeMessage -> X (Maybe (CombineTwoP (s a) l1 l2 Window))
forwardToFocused CombineTwoP (l ()) l1 l2 Window
us forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage forall a b. (a -> b) -> a -> b
$ Int -> SwapWindow
SwapWindowN forall a b. (a -> b) -> a -> b
$ Int
nforall a. Num a => a -> a -> a
-Int
1

        | Just (MoveWindowToWindow Window
w1 Window
w2) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
          Window
w1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws1,
          Window
w2 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws2 = 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 (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> l
-> l1 a
-> l2 a
-> Property
-> CombineTwoP l l1 l2 a
C2P [Window]
f (forall a. Eq a => a -> [a] -> [a]
delete Window
w1 [Window]
ws1) (Window
w1forall a. a -> [a] -> [a]
:[Window]
ws2) l ()
super l1 Window
l1 l2 Window
l2 Property
prop

        | Just (MoveWindowToWindow Window
w1 Window
w2) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
          Window
w1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws2,
          Window
w2 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws1 = 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 (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> l
-> l1 a
-> l2 a
-> Property
-> CombineTwoP l l1 l2 a
C2P [Window]
f (Window
w1forall a. a -> [a] -> [a]
:[Window]
ws1) (forall a. Eq a => a -> [a] -> [a]
delete Window
w1 [Window]
ws2) l ()
super l1 Window
l1 l2 Window
l2 Property
prop

        | Bool
otherwise = do Maybe (l1 Window)
ml1' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
l1 SomeMessage
m
                         Maybe (l2 Window)
ml2' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
l2 SomeMessage
m
                         Maybe (l ())
msuper' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l ()
super SomeMessage
m
                         if forall a. Maybe a -> Bool
isJust Maybe (l ())
msuper' Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (l1 Window)
ml1' Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (l2 Window)
ml2'
                            then 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 (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> l
-> l1 a
-> l2 a
-> Property
-> CombineTwoP l l1 l2 a
C2P [Window]
f [Window]
ws1 [Window]
ws2
                                                 (forall a. a -> Maybe a -> a
fromMaybe l ()
super Maybe (l ())
msuper')
                                                 (forall a. a -> Maybe a -> a
fromMaybe l1 Window
l1 Maybe (l1 Window)
ml1')
                                                 (forall a. a -> Maybe a -> a
fromMaybe l2 Window
l2 Maybe (l2 Window)
ml2') Property
prop
                            else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

    description :: CombineTwoP (l ()) l1 l2 Window -> String
description (C2P [Window]
_ [Window]
_ [Window]
_ l ()
super l1 Window
l1 l2 Window
l2 Property
prop) = String
"combining " forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 Window
l1 forall a. [a] -> [a] -> [a]
++ String
" and "forall a. [a] -> [a] -> [a]
++
                                forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 Window
l2 forall a. [a] -> [a] -> [a]
++ String
" with " forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l ()
super forall a. [a] -> [a] -> [a]
++ String
" using "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Property
prop

-- send focused window to the other pane. Does nothing if we don't
-- own the focused window
swap :: (LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) =>
        CombineTwoP (s a) l1 l2 Window -> X (Maybe (CombineTwoP (s a) l1 l2 Window))
swap :: forall (s :: * -> *) a (l1 :: * -> *) (l2 :: * -> *).
(LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) =>
CombineTwoP (s a) l1 l2 Window
-> X (Maybe (CombineTwoP (s a) l1 l2 Window))
swap (C2P [Window]
f [Window]
ws1 [Window]
ws2 s a
super l1 Window
l1 l2 Window
l2 Property
prop) = do
    Zipper 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 ([Window]
ws1', [Window]
ws2') = case Zipper Window
mst of
            Zipper Window
Nothing -> ([Window]
ws1, [Window]
ws2)
            Just Stack Window
st -> if Window
foc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws1
                           then (Window
foc forall a. Eq a => a -> [a] -> [a]
`delete` [Window]
ws1, Window
focforall a. a -> [a] -> [a]
:[Window]
ws2)
                           else if Window
foc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws2
                               then (Window
focforall a. a -> [a] -> [a]
:[Window]
ws1, Window
foc forall a. Eq a => a -> [a] -> [a]
`delete` [Window]
ws2)
                               else ([Window]
ws1, [Window]
ws2)
                       where foc :: Window
foc = forall a. Stack a -> a
W.focus Stack Window
st
    if ([Window]
ws1,[Window]
ws2) forall a. Eq a => a -> a -> Bool
== ([Window]
ws1',[Window]
ws2')
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        else 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 (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> l
-> l1 a
-> l2 a
-> Property
-> CombineTwoP l l1 l2 a
C2P [Window]
f [Window]
ws1' [Window]
ws2' s a
super l1 Window
l1 l2 Window
l2 Property
prop


-- forwards the message to the sublayout which contains the focused window
forwardToFocused :: (LayoutClass l1 Window, LayoutClass l2 Window, LayoutClass s a) =>
                    CombineTwoP (s a) l1 l2 Window -> SomeMessage -> X (Maybe (CombineTwoP (s a) l1 l2 Window))
forwardToFocused :: forall (l1 :: * -> *) (l2 :: * -> *) (s :: * -> *) a.
(LayoutClass l1 Window, LayoutClass l2 Window, LayoutClass s a) =>
CombineTwoP (s a) l1 l2 Window
-> SomeMessage -> X (Maybe (CombineTwoP (s a) l1 l2 Window))
forwardToFocused (C2P [Window]
f [Window]
ws1 [Window]
ws2 s a
super l1 Window
l1 l2 Window
l2 Property
prop) SomeMessage
m = do
    Maybe (l1 Window)
ml1 <- forall (l :: * -> *).
LayoutClass l Window =>
l Window -> [Window] -> SomeMessage -> X (Maybe (l Window))
forwardIfFocused l1 Window
l1 [Window]
ws1 SomeMessage
m
    Maybe (l2 Window)
ml2 <- forall (l :: * -> *).
LayoutClass l Window =>
l Window -> [Window] -> SomeMessage -> X (Maybe (l Window))
forwardIfFocused l2 Window
l2 [Window]
ws2 SomeMessage
m
    Maybe (s a)
ms <- if forall a. Maybe a -> Bool
isJust Maybe (l1 Window)
ml1 Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (l2 Window)
ml2
            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            else forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage s a
super SomeMessage
m
    if forall a. Maybe a -> Bool
isJust Maybe (l1 Window)
ml1 Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (l2 Window)
ml2 Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (s a)
ms
        then 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 (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> l
-> l1 a
-> l2 a
-> Property
-> CombineTwoP l l1 l2 a
C2P [Window]
f [Window]
ws1 [Window]
ws2 (forall a. a -> Maybe a -> a
fromMaybe s a
super Maybe (s a)
ms) (forall a. a -> Maybe a -> a
fromMaybe l1 Window
l1 Maybe (l1 Window)
ml1) (forall a. a -> Maybe a -> a
fromMaybe l2 Window
l2 Maybe (l2 Window)
ml2) Property
prop
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- forwards message m to layout l if focused window is among w
forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessage -> X (Maybe (l Window))
forwardIfFocused :: forall (l :: * -> *).
LayoutClass l Window =>
l Window -> [Window] -> SomeMessage -> X (Maybe (l Window))
forwardIfFocused l Window
l [Window]
w SomeMessage
m = do
    Zipper 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)
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) Stack Window -> X (Maybe (l Window))
send Zipper Window
mst where
    send :: Stack Window -> X (Maybe (l Window))
send Stack Window
st = if forall a. Stack a -> a
W.focus Stack Window
st forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
w
                then forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l Window
l SomeMessage
m
                else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: