{-# 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]
(Int -> ReadS SwapWindow)
-> ReadS [SwapWindow]
-> ReadPrec SwapWindow
-> ReadPrec [SwapWindow]
-> Read SwapWindow
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SwapWindow
readsPrec :: Int -> ReadS SwapWindow
$creadList :: ReadS [SwapWindow]
readList :: ReadS [SwapWindow]
$creadPrec :: ReadPrec SwapWindow
readPrec :: ReadPrec SwapWindow
$creadListPrec :: ReadPrec [SwapWindow]
readListPrec :: ReadPrec [SwapWindow]
Read, Int -> SwapWindow -> ShowS
[SwapWindow] -> ShowS
SwapWindow -> String
(Int -> SwapWindow -> ShowS)
-> (SwapWindow -> String)
-> ([SwapWindow] -> ShowS)
-> Show SwapWindow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SwapWindow -> ShowS
showsPrec :: Int -> SwapWindow -> ShowS
$cshow :: SwapWindow -> String
show :: SwapWindow -> String
$cshowList :: [SwapWindow] -> ShowS
showList :: [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]
(Int -> ReadS PartitionWins)
-> ReadS [PartitionWins]
-> ReadPrec PartitionWins
-> ReadPrec [PartitionWins]
-> Read PartitionWins
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PartitionWins
readsPrec :: Int -> ReadS PartitionWins
$creadList :: ReadS [PartitionWins]
readList :: ReadS [PartitionWins]
$creadPrec :: ReadPrec PartitionWins
readPrec :: ReadPrec PartitionWins
$creadListPrec :: ReadPrec [PartitionWins]
readListPrec :: ReadPrec [PartitionWins]
Read, Int -> PartitionWins -> ShowS
[PartitionWins] -> ShowS
PartitionWins -> String
(Int -> PartitionWins -> ShowS)
-> (PartitionWins -> String)
-> ([PartitionWins] -> ShowS)
-> Show PartitionWins
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartitionWins -> ShowS
showsPrec :: Int -> PartitionWins -> ShowS
$cshow :: PartitionWins -> String
show :: PartitionWins -> String
$cshowList :: [PartitionWins] -> ShowS
showList :: [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)
Int -> ReadS (CombineTwoP l l1 l2 a)
ReadS [CombineTwoP l l1 l2 a]
(Int -> ReadS (CombineTwoP l l1 l2 a))
-> ReadS [CombineTwoP l l1 l2 a]
-> ReadPrec (CombineTwoP l l1 l2 a)
-> ReadPrec [CombineTwoP l l1 l2 a]
-> Read (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]
$creadsPrec :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (CombineTwoP l l1 l2 a)
readsPrec :: Int -> 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]
readList :: ReadS [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)
readPrec :: 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]
readListPrec :: ReadPrec [CombineTwoP l l1 l2 a]
Read, Int -> CombineTwoP l l1 l2 a -> ShowS
[CombineTwoP l l1 l2 a] -> ShowS
CombineTwoP l l1 l2 a -> String
(Int -> CombineTwoP l l1 l2 a -> ShowS)
-> (CombineTwoP l l1 l2 a -> String)
-> ([CombineTwoP l l1 l2 a] -> ShowS)
-> Show (CombineTwoP l l1 l2 a)
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
$cshowsPrec :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
Int -> CombineTwoP l l1 l2 a -> ShowS
showsPrec :: Int -> CombineTwoP l l1 l2 a -> ShowS
$cshow :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
CombineTwoP l l1 l2 a -> String
show :: CombineTwoP l l1 l2 a -> String
$cshowList :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
[CombineTwoP l l1 l2 a] -> ShowS
showList :: [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 = [Window]
-> [Window]
-> [Window]
-> super ()
-> l1 Window
-> l2 Window
-> Property
-> CombineTwoP (super ()) l1 l2 Window
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 = Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Stack Window
s           -- passed in windows
            w1c :: [Window]
w1c = [Window]
origws [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Window]
w1      -- current windows in the first pane
            w2c :: [Window]
w2c = [Window]
origws [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Window]
w2      -- current windows in the second pane
            new :: [Window]
new = [Window]
origws [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
\\ ([Window]
w1c [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
w2c)     -- new windows
            superstack :: Maybe (Stack ())
superstack = Stack () -> Maybe (Stack ())
forall a. a -> Maybe a
Just Stack { focus :: ()
focus=(), up :: [()]
up=[], down :: [()]
down=[()] }
            f' :: [Window]
f' = Stack Window -> Window
forall a. Stack a -> a
focus Stack Window
sWindow -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:Window -> [Window] -> [Window]
forall a. Eq a => a -> [a] -> [a]
delete (Stack Window -> Window
forall a. Stack a -> a
focus Stack Window
s) [Window]
f  -- list of focused windows, contains 2 elements at most
        in do
            matching <- Property -> Window -> X Bool
hasProperty Property
prop (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
`filterM` [Window]
new  -- new windows matching predecate
            let w1' = [Window]
w1c [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
matching                   -- updated first pane windows
                w2' = [Window]
w2c [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ ([Window]
new [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Window]
matching)          -- updated second pane windows
                s1 = [Window] -> [Window] -> Zipper Window
forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [Window]
f' [Window]
w1'      -- first pane stack
                s2 = [Window] -> [Window] -> Zipper Window
forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [Window]
f' [Window]
w2'      -- second pane stack
            ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput
            (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
            (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
            return  (wrs1++wrs2, Just $ C2P f' w1' w2' (fromMaybe super msuper')
                (fromMaybe l1 ml1') (fromMaybe l2 ml2') 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   <- SomeMessage -> Maybe PartitionWins
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (CombineTwoP (l ()) l1 l2 Window)
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CombineTwoP (l ()) l1 l2 Window)
 -> X (Maybe (CombineTwoP (l ()) l1 l2 Window)))
-> (CombineTwoP (l ()) l1 l2 Window
    -> Maybe (CombineTwoP (l ()) l1 l2 Window))
-> CombineTwoP (l ()) l1 l2 Window
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CombineTwoP (l ()) l1 l2 Window
-> Maybe (CombineTwoP (l ()) l1 l2 Window)
forall a. a -> Maybe a
Just (CombineTwoP (l ()) l1 l2 Window
 -> X (Maybe (CombineTwoP (l ()) l1 l2 Window)))
-> CombineTwoP (l ()) l1 l2 Window
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window]
-> [Window]
-> l ()
-> l1 Window
-> l2 Window
-> Property
-> CombineTwoP (l ()) l1 l2 Window
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      <- SomeMessage -> Maybe SwapWindow
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = CombineTwoP (l ()) l1 l2 Window
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
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) <- SomeMessage -> Maybe SwapWindow
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = CombineTwoP (l ()) l1 l2 Window
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
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) <- SomeMessage -> Maybe SwapWindow
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = CombineTwoP (l ()) l1 l2 Window
-> SomeMessage -> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
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 (SomeMessage -> X (Maybe (CombineTwoP (l ()) l1 l2 Window)))
-> SomeMessage -> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ SwapWindow -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage (SwapWindow -> SomeMessage) -> SwapWindow -> SomeMessage
forall a b. (a -> b) -> a -> b
$ Int -> SwapWindow
SwapWindowN (Int -> SwapWindow) -> Int -> SwapWindow
forall a b. (a -> b) -> a -> b
$ Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1

        | Just (MoveWindowToWindow Window
w1 Window
w2) <- SomeMessage -> Maybe (MoveWindowToWindow Window)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
          Window
w1 Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws1,
          Window
w2 Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws2 = Maybe (CombineTwoP (l ()) l1 l2 Window)
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CombineTwoP (l ()) l1 l2 Window)
 -> X (Maybe (CombineTwoP (l ()) l1 l2 Window)))
-> Maybe (CombineTwoP (l ()) l1 l2 Window)
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ CombineTwoP (l ()) l1 l2 Window
-> Maybe (CombineTwoP (l ()) l1 l2 Window)
forall a. a -> Maybe a
Just (CombineTwoP (l ()) l1 l2 Window
 -> Maybe (CombineTwoP (l ()) l1 l2 Window))
-> CombineTwoP (l ()) l1 l2 Window
-> Maybe (CombineTwoP (l ()) l1 l2 Window)
forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window]
-> [Window]
-> l ()
-> l1 Window
-> l2 Window
-> Property
-> CombineTwoP (l ()) l1 l2 Window
forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> l
-> l1 a
-> l2 a
-> Property
-> CombineTwoP l l1 l2 a
C2P [Window]
f (Window -> [Window] -> [Window]
forall a. Eq a => a -> [a] -> [a]
delete Window
w1 [Window]
ws1) (Window
w1Window -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:[Window]
ws2) l ()
super l1 Window
l1 l2 Window
l2 Property
prop

        | Just (MoveWindowToWindow Window
w1 Window
w2) <- SomeMessage -> Maybe (MoveWindowToWindow Window)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
          Window
w1 Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws2,
          Window
w2 Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws1 = Maybe (CombineTwoP (l ()) l1 l2 Window)
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CombineTwoP (l ()) l1 l2 Window)
 -> X (Maybe (CombineTwoP (l ()) l1 l2 Window)))
-> Maybe (CombineTwoP (l ()) l1 l2 Window)
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ CombineTwoP (l ()) l1 l2 Window
-> Maybe (CombineTwoP (l ()) l1 l2 Window)
forall a. a -> Maybe a
Just (CombineTwoP (l ()) l1 l2 Window
 -> Maybe (CombineTwoP (l ()) l1 l2 Window))
-> CombineTwoP (l ()) l1 l2 Window
-> Maybe (CombineTwoP (l ()) l1 l2 Window)
forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window]
-> [Window]
-> l ()
-> l1 Window
-> l2 Window
-> Property
-> CombineTwoP (l ()) l1 l2 Window
forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> l
-> l1 a
-> l2 a
-> Property
-> CombineTwoP l l1 l2 a
C2P [Window]
f (Window
w1Window -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:[Window]
ws1) (Window -> [Window] -> [Window]
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 ml1' <- l1 Window -> SomeMessage -> X (Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
l1 SomeMessage
m
                         ml2' <- handleMessage l2 m
                         msuper' <- handleMessage super m
                         if isJust msuper' || isJust ml1' || isJust ml2'
                            then return $ Just $ C2P f ws1 ws2
                                                 (fromMaybe super msuper')
                                                 (fromMaybe l1 ml1')
                                                 (fromMaybe l2 ml2') prop
                            else return 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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l1 Window -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 Window
l1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and "String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                l2 Window -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 Window
l2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l () -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l ()
super String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" using "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Property -> String
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
    mst <- (XState -> Zipper Window) -> X (Zipper Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Workspace String (Layout Window) Window -> Zipper Window
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Zipper Window)
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> Zipper Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window 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 Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
    let (ws1', ws2') = case mst of
            Zipper Window
Nothing -> ([Window]
ws1, [Window]
ws2)
            Just Stack Window
st -> if Window
foc Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws1
                           then (Window
foc Window -> [Window] -> [Window]
forall a. Eq a => a -> [a] -> [a]
`delete` [Window]
ws1, Window
focWindow -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:[Window]
ws2)
                           else if Window
foc Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws2
                               then (Window
focWindow -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:[Window]
ws1, Window
foc Window -> [Window] -> [Window]
forall a. Eq a => a -> [a] -> [a]
`delete` [Window]
ws2)
                               else ([Window]
ws1, [Window]
ws2)
                       where foc :: Window
foc = Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
st
    if (ws1,ws2) == (ws1',ws2')
        then return Nothing
        else return $ Just $ C2P f ws1' ws2' super l1 l2 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
    ml1 <- l1 Window -> [Window] -> SomeMessage -> X (Maybe (l1 Window))
forall (l :: * -> *).
LayoutClass l Window =>
l Window -> [Window] -> SomeMessage -> X (Maybe (l Window))
forwardIfFocused l1 Window
l1 [Window]
ws1 SomeMessage
m
    ml2 <- forwardIfFocused l2 ws2 m
    ms <- if isJust ml1 || isJust ml2
            then return Nothing
            else handleMessage super m
    if isJust ml1 || isJust ml2 || isJust ms
        then return $ Just $ C2P f ws1 ws2 (fromMaybe super ms) (fromMaybe l1 ml1) (fromMaybe l2 ml2) prop
        else return 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
    mst <- (XState -> Zipper Window) -> X (Zipper Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Workspace String (Layout Window) Window -> Zipper Window
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Zipper Window)
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> Zipper Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window 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 Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
    maybe (return Nothing) send mst where
    send :: Stack Window -> X (Maybe (l Window))
send Stack Window
st = if Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
st Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
w
                then l Window -> SomeMessage -> X (Maybe (l Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l Window
l SomeMessage
m
                else Maybe (l Window) -> X (Maybe (l Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (l Window)
forall a. Maybe a
Nothing

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