{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE UndecidableInstances #-}
module XMonad.Layout.Combo (
combineTwo,
CombineTwo
) where
import XMonad hiding (focus)
import XMonad.Layout.WindowNavigation (MoveWindowToWindow (..))
import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\), listToMaybe)
import XMonad.StackSet (Stack (..), Workspace (..), integrate')
import XMonad.Util.Stack (zipperFocusedAtFirstOf)
data CombineTwo l l1 l2 a = C2 [a] [a] l (l1 a) (l2 a)
deriving (ReadPrec [CombineTwo l l1 l2 a]
ReadPrec (CombineTwo l l1 l2 a)
ReadS [CombineTwo 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 [CombineTwo l l1 l2 a]
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadPrec (CombineTwo l l1 l2 a)
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (CombineTwo l l1 l2 a)
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadS [CombineTwo l l1 l2 a]
readListPrec :: ReadPrec [CombineTwo l l1 l2 a]
$creadListPrec :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadPrec [CombineTwo l l1 l2 a]
readPrec :: ReadPrec (CombineTwo l l1 l2 a)
$creadPrec :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadPrec (CombineTwo l l1 l2 a)
readList :: ReadS [CombineTwo l l1 l2 a]
$creadList :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadS [CombineTwo l l1 l2 a]
readsPrec :: Int -> ReadS (CombineTwo l l1 l2 a)
$creadsPrec :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (CombineTwo l l1 l2 a)
Read, Int -> CombineTwo 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 -> CombineTwo l l1 l2 a -> ShowS
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
[CombineTwo l l1 l2 a] -> ShowS
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
CombineTwo l l1 l2 a -> String
showList :: [CombineTwo l l1 l2 a] -> ShowS
$cshowList :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
[CombineTwo l l1 l2 a] -> ShowS
show :: CombineTwo l l1 l2 a -> String
$cshow :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
CombineTwo l l1 l2 a -> String
showsPrec :: Int -> CombineTwo l l1 l2 a -> ShowS
$cshowsPrec :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
Int -> CombineTwo l l1 l2 a -> ShowS
Show)
combineTwo :: (Read a, Eq a, LayoutClass super (), LayoutClass l1 a, LayoutClass l2 a) =>
super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a
combineTwo :: forall a (super :: * -> *) (l1 :: * -> *) (l2 :: * -> *).
(Read a, Eq a, LayoutClass super (), LayoutClass l1 a,
LayoutClass l2 a) =>
super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a
combineTwo = forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [] []
instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
=> LayoutClass (CombineTwo (l ()) l1 l2) a where
runLayout :: Workspace String (CombineTwo (l ()) l1 l2 a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
runLayout (Workspace String
_ (C2 [a]
f [a]
w2 l ()
super l1 a
l1 l2 a
l2) Maybe (Stack a)
s) Rectangle
rinput = [a] -> X ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
arrange (forall a. Maybe (Stack a) -> [a]
integrate' Maybe (Stack a)
s)
where arrange :: [a] -> X ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
arrange [] = do l1 a
l1' <- forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
l1 (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
l2 a
l2' <- forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
l2 (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
l ()
super' <- forall a. a -> Maybe a -> a
fromMaybe l ()
super forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l ()
super (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [] [] l ()
super' l1 a
l1' l2 a
l2')
arrange [a
w] = do l1 a
l1' <- forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
l1 (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
l2 a
l2' <- forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
l2 (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
l ()
super' <- forall a. a -> Maybe a -> a
fromMaybe l ()
super forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l ()
super (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a
w,Rectangle
rinput)], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [a
w] [a
w] l ()
super' l1 a
l1' l2 a
l2')
arrange [a]
origws =
do let w2' :: [a]
w2' = case [a]
origws forall a. Eq a => [a] -> [a] -> [a]
`intersect` [a]
w2 of [] -> forall a. Int -> [a] -> [a]
take Int
1 [a]
origws
[a
x] -> [a
x]
[a]
x -> case [a]
origws forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
x of
[] -> forall a. [a] -> [a]
init [a]
x
[a]
_ -> [a]
x
superstack :: Stack ()
superstack = Stack { focus :: ()
focus=(), up :: [()]
up=[], down :: [()]
down=[()] }
s1 :: Maybe (Stack a)
s1 = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [a]
f' ([a]
origws forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
w2')
s2 :: Maybe (Stack a)
s2 = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [a]
f' [a]
w2'
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
([((),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 (forall a. a -> Maybe a
Just Stack ()
superstack)) Rectangle
rinput
([(a, Rectangle)]
wrs1, Maybe (l1 a)
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 a
l1 Maybe (Stack a)
s1) Rectangle
r1
([(a, Rectangle)]
wrs2, Maybe (l2 a)
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 a
l2 Maybe (Stack a)
s2) Rectangle
r2
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs1forall a. [a] -> [a] -> [a]
++[(a, Rectangle)]
wrs2, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [a]
f' [a]
w2'
(forall a. a -> Maybe a -> a
fromMaybe l ()
super Maybe (l ())
msuper') (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'))
handleMessage :: CombineTwo (l ()) l1 l2 a
-> SomeMessage -> X (Maybe (CombineTwo (l ()) l1 l2 a))
handleMessage (C2 [a]
f [a]
ws2 l ()
super l1 a
l1 l2 a
l2) SomeMessage
m
| Just (MoveWindowToWindow a
w1 a
w2) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
a
w1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
ws2,
a
w2 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ws2 = do l1 a
l1' <- forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
l1 SomeMessage
m
l2 a
l2' <- forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
l2 SomeMessage
m
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] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [a]
f (a
w1forall a. a -> [a] -> [a]
:[a]
ws2) l ()
super l1 a
l1' l2 a
l2'
| Just (MoveWindowToWindow a
w1 a
w2) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
a
w1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ws2,
a
w2 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
ws2 = do l1 a
l1' <- forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
l1 SomeMessage
m
l2 a
l2' <- forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
l2 SomeMessage
m
let ws2' :: [a]
ws2' = case forall a. Eq a => a -> [a] -> [a]
delete a
w1 [a]
ws2 of [] -> [a
w2]
[a]
x -> [a]
x
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] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [a]
f [a]
ws2' l ()
super l1 a
l1' l2 a
l2'
| Bool
otherwise = do Maybe [l1 a]
ml1' <- forall (l :: * -> *) b.
LayoutClass l b =>
SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate SomeMessage
m [l1 a
l1]
Maybe [l2 a]
ml2' <- forall (l :: * -> *) b.
LayoutClass l b =>
SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate SomeMessage
m [l2 a
l2]
Maybe [l ()]
msuper' <- forall (l :: * -> *) b.
LayoutClass l b =>
SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate SomeMessage
m [l ()
super]
if forall a. Maybe a -> Bool
isJust Maybe [l ()]
msuper' Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe [l1 a]
ml1' Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe [l2 a]
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] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [a]
f [a]
ws2
(forall a. a -> Maybe a -> a
fromMaybe l ()
super (forall a. [a] -> Maybe a
listToMaybe forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [l ()]
msuper'))
(forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 (forall a. [a] -> Maybe a
listToMaybe forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [l1 a]
ml1'))
(forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 (forall a. [a] -> Maybe a
listToMaybe forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [l2 a]
ml2'))
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
description :: CombineTwo (l ()) l1 l2 a -> String
description (C2 [a]
_ [a]
_ l ()
super l1 a
l1 l2 a
l2) = String
"combining "forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
l1 forall a. [a] -> [a] -> [a]
++String
" and "forall a. [a] -> [a] -> [a]
++
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 a
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
broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate :: forall (l :: * -> *) b.
LayoutClass l b =>
SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate SomeMessage
a [l b]
ol = do [Maybe (l b)]
nml <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {layout :: * -> *} {a}.
LayoutClass layout a =>
layout a -> X (Maybe (layout a))
f [l b]
ol
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isJust [Maybe (l b)]
nml
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 a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` forall a. a -> a
id) [l b]
ol [Maybe (l b)]
nml
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
where f :: layout a -> X (Maybe (layout a))
f layout a
l = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage layout a
l SomeMessage
a forall a. X a -> X a -> X a
`catchX` forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing