{-# 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.Prelude
import XMonad hiding (focus)
import XMonad.StackSet ( Workspace (..), Stack(..) )
import XMonad.Layout.WindowNavigation
import XMonad.Util.WindowProperties
import qualified XMonad.StackSet as W

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.ComboP
--
-- and add something like
--
-- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) (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:
--
-- "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
-- "XMonad.Doc.Extending#Editing_key_bindings".

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
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
(Int -> SwapWindow -> ShowS)
-> (SwapWindow -> String)
-> ([SwapWindow] -> ShowS)
-> Show SwapWindow
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]
(Int -> ReadS PartitionWins)
-> ReadS [PartitionWins]
-> ReadPrec PartitionWins
-> ReadPrec [PartitionWins]
-> Read 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
(Int -> PartitionWins -> ShowS)
-> (PartitionWins -> String)
-> ([PartitionWins] -> ShowS)
-> Show PartitionWins
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)
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]
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
[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
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 :: 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 :: forall a. a -> [a] -> [a] -> Stack a
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
            [Window]
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]
w1' = [Window]
w1c [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
matching                     -- updated first pane windows
                w2' :: [Window]
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 :: Maybe (Stack Window)
s1 = [Window] -> [Window] -> Maybe (Stack Window)
forall q. Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate [Window]
f' [Window]
w1'                 -- first pane stack
                s2 :: Maybe (Stack Window)
s2 = [Window] -> [Window] -> Maybe (Stack Window)
forall q. Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate [Window]
f' [Window]
w2'                 -- second pane stack
            ([((),Rectangle
r1),((),Rectangle
r2)], Maybe (l ())
msuper') <- Workspace String (l ()) ()
-> Rectangle -> X ([((), Rectangle)], Maybe (l ()))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> l () -> Maybe (Stack ()) -> Workspace String (l ()) ()
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') <- Workspace String (l1 Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l1 Window
-> Maybe (Stack Window)
-> Workspace String (l1 Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
"" l1 Window
l1 Maybe (Stack Window)
s1) Rectangle
r1
            ([(Window, Rectangle)]
wrs2, Maybe (l2 Window)
ml2') <- Workspace String (l2 Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l2 Window
-> Maybe (Stack Window)
-> Workspace String (l2 Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
"" l2 Window
l2 Maybe (Stack Window)
s2) Rectangle
r2
            ([(Window, Rectangle)], Maybe (CombineTwoP (l ()) l1 l2 Window))
-> X ([(Window, Rectangle)],
      Maybe (CombineTwoP (l ()) l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return  ([(Window, Rectangle)]
wrs1[(Window, Rectangle)]
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. [a] -> [a] -> [a]
++[(Window, Rectangle)]
wrs2, 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]
w1' [Window]
w2' (l () -> Maybe (l ()) -> l ()
forall a. a -> Maybe a -> a
fromMaybe l ()
super Maybe (l ())
msuper')
                (l1 Window -> Maybe (l1 Window) -> l1 Window
forall a. a -> Maybe a -> a
fromMaybe l1 Window
l1 Maybe (l1 Window)
ml1') (l2 Window -> Maybe (l2 Window) -> l2 Window
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   <- 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 (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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws1,
          Window
w2 Window -> [Window] -> 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 (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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ws2,
          Window
w2 Window -> [Window] -> 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 (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 Maybe (l1 Window)
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
                         Maybe (l2 Window)
ml2' <- l2 Window -> SomeMessage -> X (Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
l2 SomeMessage
m
                         Maybe (l ())
msuper' <- l () -> SomeMessage -> X (Maybe (l ()))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l ()
super SomeMessage
m
                         if Maybe (l ()) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l ())
msuper' Bool -> Bool -> Bool
|| Maybe (l1 Window) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l1 Window)
ml1' Bool -> Bool -> Bool
|| Maybe (l2 Window) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l2 Window)
ml2'
                            then Maybe (CombineTwoP (l ()) l1 l2 Window)
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
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]
ws1 [Window]
ws2
                                                 (l () -> Maybe (l ()) -> l ()
forall a. a -> Maybe a -> a
fromMaybe l ()
super Maybe (l ())
msuper')
                                                 (l1 Window -> Maybe (l1 Window) -> l1 Window
forall a. a -> Maybe a -> a
fromMaybe l1 Window
l1 Maybe (l1 Window)
ml1')
                                                 (l2 Window -> Maybe (l2 Window) -> l2 Window
forall a. a -> Maybe a -> a
fromMaybe l2 Window
l2 Maybe (l2 Window)
ml2') Property
prop
                            else Maybe (CombineTwoP (l ()) l1 l2 Window)
-> X (Maybe (CombineTwoP (l ()) l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CombineTwoP (l ()) l1 l2 Window)
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 " 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 :: 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
    Maybe (Stack Window)
mst <- (XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> Maybe (Stack 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 ([Window]
ws1', [Window]
ws2') = case Maybe (Stack Window)
mst of
            Maybe (Stack Window)
Nothing -> ([Window]
ws1, [Window]
ws2)
            Just Stack Window
st -> if Window
foc Window -> [Window] -> 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 (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 ([Window]
ws1,[Window]
ws2) ([Window], [Window]) -> ([Window], [Window]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([Window]
ws1',[Window]
ws2')
        then Maybe (CombineTwoP (s a) l1 l2 Window)
-> X (Maybe (CombineTwoP (s a) l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CombineTwoP (s a) l1 l2 Window)
forall a. Maybe a
Nothing
        else Maybe (CombineTwoP (s a) l1 l2 Window)
-> X (Maybe (CombineTwoP (s a) l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CombineTwoP (s a) l1 l2 Window)
 -> X (Maybe (CombineTwoP (s a) l1 l2 Window)))
-> Maybe (CombineTwoP (s a) l1 l2 Window)
-> X (Maybe (CombineTwoP (s a) l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ CombineTwoP (s a) l1 l2 Window
-> Maybe (CombineTwoP (s a) l1 l2 Window)
forall a. a -> Maybe a
Just (CombineTwoP (s a) l1 l2 Window
 -> Maybe (CombineTwoP (s a) l1 l2 Window))
-> CombineTwoP (s a) l1 l2 Window
-> Maybe (CombineTwoP (s a) l1 l2 Window)
forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window]
-> [Window]
-> s a
-> l1 Window
-> l2 Window
-> Property
-> CombineTwoP (s a) 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]
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 :: 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 <- 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
    Maybe (l2 Window)
ml2 <- l2 Window -> [Window] -> SomeMessage -> X (Maybe (l2 Window))
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 Maybe (l1 Window) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l1 Window)
ml1 Bool -> Bool -> Bool
|| Maybe (l2 Window) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l2 Window)
ml2
            then Maybe (s a) -> X (Maybe (s a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (s a)
forall a. Maybe a
Nothing
            else s a -> SomeMessage -> X (Maybe (s a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage s a
super SomeMessage
m
    if Maybe (l1 Window) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l1 Window)
ml1 Bool -> Bool -> Bool
|| Maybe (l2 Window) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l2 Window)
ml2 Bool -> Bool -> Bool
|| Maybe (s a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (s a)
ms
        then Maybe (CombineTwoP (s a) l1 l2 Window)
-> X (Maybe (CombineTwoP (s a) l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CombineTwoP (s a) l1 l2 Window)
 -> X (Maybe (CombineTwoP (s a) l1 l2 Window)))
-> Maybe (CombineTwoP (s a) l1 l2 Window)
-> X (Maybe (CombineTwoP (s a) l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ CombineTwoP (s a) l1 l2 Window
-> Maybe (CombineTwoP (s a) l1 l2 Window)
forall a. a -> Maybe a
Just (CombineTwoP (s a) l1 l2 Window
 -> Maybe (CombineTwoP (s a) l1 l2 Window))
-> CombineTwoP (s a) l1 l2 Window
-> Maybe (CombineTwoP (s a) l1 l2 Window)
forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window]
-> [Window]
-> s a
-> l1 Window
-> l2 Window
-> Property
-> CombineTwoP (s a) 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]
ws1 [Window]
ws2 (s a -> Maybe (s a) -> s a
forall a. a -> Maybe a -> a
fromMaybe s a
super Maybe (s a)
ms) (l1 Window -> Maybe (l1 Window) -> l1 Window
forall a. a -> Maybe a -> a
fromMaybe l1 Window
l1 Maybe (l1 Window)
ml1) (l2 Window -> Maybe (l2 Window) -> l2 Window
forall a. a -> Maybe a -> a
fromMaybe l2 Window
l2 Maybe (l2 Window)
ml2) Property
prop
        else Maybe (CombineTwoP (s a) l1 l2 Window)
-> X (Maybe (CombineTwoP (s a) l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CombineTwoP (s a) l1 l2 Window)
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 :: l Window -> [Window] -> SomeMessage -> X (Maybe (l Window))
forwardIfFocused l Window
l [Window]
w SomeMessage
m = do
    Maybe (Stack Window)
mst <- (XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> Maybe (Stack 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)
    X (Maybe (l Window))
-> (Stack Window -> X (Maybe (l Window)))
-> Maybe (Stack Window)
-> X (Maybe (l Window))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (l Window) -> X (Maybe (l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (l Window)
forall a. Maybe a
Nothing) Stack Window -> X (Maybe (l Window))
send Maybe (Stack Window)
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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe (l Window)
forall a. Maybe a
Nothing

-- code from CombineTwo
-- given two sets of zs and xs takes the first z from zs that also belongs to xs
-- and turns xs into a stack with z being current element. Acts as
-- StackSet.differentiate if zs and xs don't intersect
differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate :: [q] -> [q] -> Maybe (Stack q)
differentiate (q
z:[q]
zs) [q]
xs | q
z q -> [q] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [q]
xs = Stack q -> Maybe (Stack q)
forall a. a -> Maybe a
Just (Stack q -> Maybe (Stack q)) -> Stack q -> Maybe (Stack q)
forall a b. (a -> b) -> a -> b
$ Stack :: forall a. a -> [a] -> [a] -> Stack a
Stack { focus :: q
focus=q
z
                                                     , up :: [q]
up = [q] -> [q]
forall a. [a] -> [a]
reverse ([q] -> [q]) -> [q] -> [q]
forall a b. (a -> b) -> a -> b
$ (q -> Bool) -> [q] -> [q]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (q -> q -> Bool
forall a. Eq a => a -> a -> Bool
/=q
z) [q]
xs
                                                     , down :: [q]
down = [q] -> [q]
forall a. [a] -> [a]
tail ([q] -> [q]) -> [q] -> [q]
forall a b. (a -> b) -> a -> b
$ (q -> Bool) -> [q] -> [q]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (q -> q -> Bool
forall a. Eq a => a -> a -> Bool
/=q
z) [q]
xs }
                        | Bool
otherwise = [q] -> [q] -> Maybe (Stack q)
forall q. Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate [q]
zs [q]
xs
differentiate [] [q]
xs = [q] -> Maybe (Stack q)
forall a. [a] -> Maybe (Stack a)
W.differentiate [q]
xs

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