{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
module XMonad.Layout (
Full(..), Tall(..), Mirror(..),
Resize(..), IncMasterN(..), Choose(..), (|||), CLR(..), ChangeLayout(..), JumpToLayout(..),
mirrorRect, splitVertically,
splitHorizontally, splitHorizontallyBy, splitVerticallyBy,
tile
) where
import XMonad.Core
import Graphics.X11 (Rectangle(..))
import Graphics.X11.Xlib.Extras ( Event(DestroyWindowEvent) )
import qualified XMonad.StackSet as W
import Control.Arrow ((***), second)
import Control.Monad
import Data.Maybe (fromMaybe)
data Resize = Shrink | Expand
newtype IncMasterN = IncMasterN Int
instance Message Resize
instance Message IncMasterN
data Full a = Full deriving (Int -> Full a -> ShowS
forall a. Int -> Full a -> ShowS
forall a. [Full a] -> ShowS
forall a. Full a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Full a] -> ShowS
$cshowList :: forall a. [Full a] -> ShowS
show :: Full a -> String
$cshow :: forall a. Full a -> String
showsPrec :: Int -> Full a -> ShowS
$cshowsPrec :: forall a. Int -> Full a -> ShowS
Show, ReadPrec [Full a]
ReadPrec (Full a)
ReadS [Full a]
forall a. ReadPrec [Full a]
forall a. ReadPrec (Full a)
forall a. Int -> ReadS (Full a)
forall a. ReadS [Full a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Full a]
$creadListPrec :: forall a. ReadPrec [Full a]
readPrec :: ReadPrec (Full a)
$creadPrec :: forall a. ReadPrec (Full a)
readList :: ReadS [Full a]
$creadList :: forall a. ReadS [Full a]
readsPrec :: Int -> ReadS (Full a)
$creadsPrec :: forall a. Int -> ReadS (Full a)
Read)
instance LayoutClass Full a
data Tall a = Tall { forall a. Tall a -> Int
tallNMaster :: !Int
, forall a. Tall a -> Rational
tallRatioIncrement :: !Rational
, forall a. Tall a -> Rational
tallRatio :: !Rational
}
deriving (Int -> Tall a -> ShowS
forall a. Int -> Tall a -> ShowS
forall a. [Tall a] -> ShowS
forall a. Tall a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tall a] -> ShowS
$cshowList :: forall a. [Tall a] -> ShowS
show :: Tall a -> String
$cshow :: forall a. Tall a -> String
showsPrec :: Int -> Tall a -> ShowS
$cshowsPrec :: forall a. Int -> Tall a -> ShowS
Show, ReadPrec [Tall a]
ReadPrec (Tall a)
ReadS [Tall a]
forall a. ReadPrec [Tall a]
forall a. ReadPrec (Tall a)
forall a. Int -> ReadS (Tall a)
forall a. ReadS [Tall a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tall a]
$creadListPrec :: forall a. ReadPrec [Tall a]
readPrec :: ReadPrec (Tall a)
$creadPrec :: forall a. ReadPrec (Tall a)
readList :: ReadS [Tall a]
$creadList :: forall a. ReadS [Tall a]
readsPrec :: Int -> ReadS (Tall a)
$creadsPrec :: forall a. Int -> ReadS (Tall a)
Read)
instance LayoutClass Tall a where
pureLayout :: Tall a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (Tall Int
nmaster Rational
_ Rational
frac) Rectangle
r Stack a
s
| Rational
frac forall a. Eq a => a -> a -> Bool
== Rational
0 = forall a. Int -> [a] -> [a]
drop Int
nmaster [(a, Rectangle)]
layout
| Rational
frac forall a. Eq a => a -> a -> Bool
== Rational
1 = forall a. Int -> [a] -> [a]
take Int
nmaster [(a, Rectangle)]
layout
| Bool
otherwise = [(a, Rectangle)]
layout
where ws :: [a]
ws = forall a. Stack a -> [a]
W.integrate Stack a
s
rs :: [Rectangle]
rs = Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
frac Rectangle
r Int
nmaster (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws)
layout :: [(a, Rectangle)]
layout = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rs
pureMessage :: Tall a -> SomeMessage -> Maybe (Tall a)
pureMessage (Tall Int
nmaster Rational
delta Rational
frac) SomeMessage
m =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Resize -> Tall a
resize (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. IncMasterN -> Tall a
incmastern (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]
where resize :: Resize -> Tall a
resize Resize
Shrink = forall a. Int -> Rational -> Rational -> Tall a
Tall Int
nmaster Rational
delta (forall a. Ord a => a -> a -> a
max Rational
0 forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
-Rational
delta)
resize Resize
Expand = forall a. Int -> Rational -> Rational -> Tall a
Tall Int
nmaster Rational
delta (forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
+Rational
delta)
incmastern :: IncMasterN -> Tall a
incmastern (IncMasterN Int
d) = forall a. Int -> Rational -> Rational -> Tall a
Tall (forall a. Ord a => a -> a -> a
max Int
0 (Int
nmasterforall a. Num a => a -> a -> a
+Int
d)) Rational
delta Rational
frac
description :: Tall a -> String
description Tall a
_ = String
"Tall"
tile
:: Rational
-> Rectangle
-> Int
-> Int
-> [Rectangle]
tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
f Rectangle
r Int
nmaster Int
n = if Int
n forall a. Ord a => a -> a -> Bool
<= Int
nmaster Bool -> Bool -> Bool
|| Int
nmaster forall a. Eq a => a -> a -> Bool
== Int
0
then Int -> Rectangle -> [Rectangle]
splitVertically Int
n Rectangle
r
else Int -> Rectangle -> [Rectangle]
splitVertically Int
nmaster Rectangle
r1 forall a. [a] -> [a] -> [a]
++ Int -> Rectangle -> [Rectangle]
splitVertically (Int
nforall a. Num a => a -> a -> a
-Int
nmaster) Rectangle
r2
where (Rectangle
r1,Rectangle
r2) = forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
f Rectangle
r
splitVertically, splitHorizontally :: Int -> Rectangle -> [Rectangle]
splitVertically :: Int -> Rectangle -> [Rectangle]
splitVertically Int
n Rectangle
r | Int
n forall a. Ord a => a -> a -> Bool
< Int
2 = [Rectangle
r]
splitVertically Int
n (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw Dimension
smallh forall a. a -> [a] -> [a]
:
Int -> Rectangle -> [Rectangle]
splitVertically (Int
nforall a. Num a => a -> a -> a
-Int
1) (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
syforall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
smallh) Dimension
sw (Dimension
shforall a. Num a => a -> a -> a
-Dimension
smallh))
where smallh :: Dimension
smallh = Dimension
sh forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
splitHorizontally :: Int -> Rectangle -> [Rectangle]
splitHorizontally Int
n = forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Rectangle
mirrorRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rectangle -> [Rectangle]
splitVertically Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> Rectangle
mirrorRect
splitHorizontallyBy, splitVerticallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy :: forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy r
f (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) =
( Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
leftw Dimension
sh
, Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
leftw) Position
sy (Dimension
swforall a. Num a => a -> a -> a
-forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
leftw) Dimension
sh)
where leftw :: Dimension
leftw = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw forall a. Num a => a -> a -> a
* r
f
splitVerticallyBy :: forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy r
f = (Rectangle -> Rectangle
mirrorRect forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Rectangle -> Rectangle
mirrorRect) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> Rectangle
mirrorRect
newtype Mirror l a = Mirror (l a) deriving (Int -> Mirror l a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: * -> *) a. Show (l a) => Int -> Mirror l a -> ShowS
forall (l :: * -> *) a. Show (l a) => [Mirror l a] -> ShowS
forall (l :: * -> *) a. Show (l a) => Mirror l a -> String
showList :: [Mirror l a] -> ShowS
$cshowList :: forall (l :: * -> *) a. Show (l a) => [Mirror l a] -> ShowS
show :: Mirror l a -> String
$cshow :: forall (l :: * -> *) a. Show (l a) => Mirror l a -> String
showsPrec :: Int -> Mirror l a -> ShowS
$cshowsPrec :: forall (l :: * -> *) a. Show (l a) => Int -> Mirror l a -> ShowS
Show, ReadPrec [Mirror l a]
ReadPrec (Mirror l a)
ReadS [Mirror l a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l :: * -> *) a. Read (l a) => ReadPrec [Mirror l a]
forall (l :: * -> *) a. Read (l a) => ReadPrec (Mirror l a)
forall (l :: * -> *) a. Read (l a) => Int -> ReadS (Mirror l a)
forall (l :: * -> *) a. Read (l a) => ReadS [Mirror l a]
readListPrec :: ReadPrec [Mirror l a]
$creadListPrec :: forall (l :: * -> *) a. Read (l a) => ReadPrec [Mirror l a]
readPrec :: ReadPrec (Mirror l a)
$creadPrec :: forall (l :: * -> *) a. Read (l a) => ReadPrec (Mirror l a)
readList :: ReadS [Mirror l a]
$creadList :: forall (l :: * -> *) a. Read (l a) => ReadS [Mirror l a]
readsPrec :: Int -> ReadS (Mirror l a)
$creadsPrec :: forall (l :: * -> *) a. Read (l a) => Int -> ReadS (Mirror l a)
Read)
instance LayoutClass l a => LayoutClass (Mirror l) a where
runLayout :: Workspace String (Mirror l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (Mirror l a))
runLayout (W.Workspace String
i (Mirror l a
l) Maybe (Stack a)
ms) Rectangle
r = (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Rectangle -> Rectangle
mirrorRect) forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (l :: * -> *) a. l a -> Mirror l a
Mirror)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` 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
W.Workspace String
i l a
l Maybe (Stack a)
ms) (Rectangle -> Rectangle
mirrorRect Rectangle
r)
handleMessage :: Mirror l a -> SomeMessage -> X (Maybe (Mirror l a))
handleMessage (Mirror l a
l) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (l :: * -> *) a. l a -> Mirror l a
Mirror) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l
description :: Mirror l a -> String
description (Mirror l a
l) = String
"Mirror "forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l a
l
mirrorRect :: Rectangle -> Rectangle
mirrorRect :: Rectangle -> Rectangle
mirrorRect (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
ry Position
rx Dimension
rh Dimension
rw
data ChangeLayout = FirstLayout | NextLayout deriving (ChangeLayout -> ChangeLayout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeLayout -> ChangeLayout -> Bool
$c/= :: ChangeLayout -> ChangeLayout -> Bool
== :: ChangeLayout -> ChangeLayout -> Bool
$c== :: ChangeLayout -> ChangeLayout -> Bool
Eq, Int -> ChangeLayout -> ShowS
[ChangeLayout] -> ShowS
ChangeLayout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeLayout] -> ShowS
$cshowList :: [ChangeLayout] -> ShowS
show :: ChangeLayout -> String
$cshow :: ChangeLayout -> String
showsPrec :: Int -> ChangeLayout -> ShowS
$cshowsPrec :: Int -> ChangeLayout -> ShowS
Show)
instance Message ChangeLayout
newtype JumpToLayout = JumpToLayout String
instance Message JumpToLayout
(|||) :: l a -> r a -> Choose l r a
||| :: forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
(|||) = forall (l :: * -> *) (r :: * -> *) a.
CLR -> l a -> r a -> Choose l r a
Choose CLR
CL
infixr 5 |||
data Choose l r a = Choose CLR (l a) (r a) deriving (ReadPrec [Choose l r a]
ReadPrec (Choose l r a)
ReadS [Choose l r a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec [Choose l r a]
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec (Choose l r a)
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
Int -> ReadS (Choose l r a)
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadS [Choose l r a]
readListPrec :: ReadPrec [Choose l r a]
$creadListPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec [Choose l r a]
readPrec :: ReadPrec (Choose l r a)
$creadPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec (Choose l r a)
readList :: ReadS [Choose l r a]
$creadList :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadS [Choose l r a]
readsPrec :: Int -> ReadS (Choose l r a)
$creadsPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
Int -> ReadS (Choose l r a)
Read, Int -> Choose l r a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
Int -> Choose l r a -> ShowS
forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
[Choose l r a] -> ShowS
forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
Choose l r a -> String
showList :: [Choose l r a] -> ShowS
$cshowList :: forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
[Choose l r a] -> ShowS
show :: Choose l r a -> String
$cshow :: forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
Choose l r a -> String
showsPrec :: Int -> Choose l r a -> ShowS
$cshowsPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
Int -> Choose l r a -> ShowS
Show)
data CLR = CL | CR deriving (ReadPrec [CLR]
ReadPrec CLR
Int -> ReadS CLR
ReadS [CLR]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CLR]
$creadListPrec :: ReadPrec [CLR]
readPrec :: ReadPrec CLR
$creadPrec :: ReadPrec CLR
readList :: ReadS [CLR]
$creadList :: ReadS [CLR]
readsPrec :: Int -> ReadS CLR
$creadsPrec :: Int -> ReadS CLR
Read, Int -> CLR -> ShowS
[CLR] -> ShowS
CLR -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CLR] -> ShowS
$cshowList :: [CLR] -> ShowS
show :: CLR -> String
$cshow :: CLR -> String
showsPrec :: Int -> CLR -> ShowS
$cshowsPrec :: Int -> CLR -> ShowS
Show, CLR -> CLR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CLR -> CLR -> Bool
$c/= :: CLR -> CLR -> Bool
== :: CLR -> CLR -> Bool
$c== :: CLR -> CLR -> Bool
Eq)
data NextNoWrap = NextNoWrap deriving (NextNoWrap -> NextNoWrap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NextNoWrap -> NextNoWrap -> Bool
$c/= :: NextNoWrap -> NextNoWrap -> Bool
== :: NextNoWrap -> NextNoWrap -> Bool
$c== :: NextNoWrap -> NextNoWrap -> Bool
Eq, Int -> NextNoWrap -> ShowS
[NextNoWrap] -> ShowS
NextNoWrap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NextNoWrap] -> ShowS
$cshowList :: [NextNoWrap] -> ShowS
show :: NextNoWrap -> String
$cshow :: NextNoWrap -> String
showsPrec :: Int -> NextNoWrap -> ShowS
$cshowsPrec :: Int -> NextNoWrap -> ShowS
Show)
instance Message NextNoWrap
handle :: (LayoutClass l a, Message m) => l a -> m -> X (Maybe (l a))
handle :: forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l m
m = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l (forall a. Message a => a -> SomeMessage
SomeMessage m
m)
choose :: (LayoutClass l a, LayoutClass r a)
=> Choose l r a -> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose :: forall (l :: * -> *) a (r :: * -> *).
(LayoutClass l a, LayoutClass r a) =>
Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose (Choose CLR
d l a
_ r a
_) CLR
d' Maybe (l a)
Nothing Maybe (r a)
Nothing | CLR
d forall a. Eq a => a -> a -> Bool
== CLR
d' = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
choose (Choose CLR
d l a
l r a
r) CLR
d' Maybe (l a)
ml Maybe (r a)
mr = forall {f :: * -> *} {l :: * -> *} {a} {r :: * -> *}.
Monad f =>
(f (l a), f (r a)) -> f (Maybe (Choose l r a))
f (X (l a), X (r a))
lr
where
(l a
l', r a
r') = (forall a. a -> Maybe a -> a
fromMaybe l a
l Maybe (l a)
ml, forall a. a -> Maybe a -> a
fromMaybe r a
r Maybe (r a)
mr)
lr :: (X (l a), X (r a))
lr = case (CLR
d, CLR
d') of
(CLR
CL, CLR
CR) -> (forall {l :: * -> *} {a}. LayoutClass l a => l a -> X (l a)
hide l a
l' , forall (m :: * -> *) a. Monad m => a -> m a
return r a
r')
(CLR
CR, CLR
CL) -> (forall (m :: * -> *) a. Monad m => a -> m a
return l a
l', forall {l :: * -> *} {a}. LayoutClass l a => l a -> X (l a)
hide r a
r' )
(CLR
_ , CLR
_ ) -> (forall (m :: * -> *) a. Monad m => a -> m a
return l a
l', forall (m :: * -> *) a. Monad m => a -> m a
return r a
r')
f :: (f (l a), f (r a)) -> f (Maybe (Choose l r a))
f (f (l a)
x,f (r a)
y) = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (forall (l :: * -> *) (r :: * -> *) a.
CLR -> l a -> r a -> Choose l r a
Choose CLR
d') f (l a)
x f (r a)
y
hide :: l a -> X (l a)
hide l a
x = forall a. a -> Maybe a -> a
fromMaybe l a
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
x LayoutMessages
Hide
instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
runLayout :: Workspace String (Choose l r a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (Choose l r a))
runLayout (W.Workspace String
i (Choose CLR
CL l a
l r a
r) Maybe (Stack a)
ms) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (l :: * -> *) (r :: * -> *) a.
CLR -> l a -> r a -> Choose l r a
Choose CLR
CL) r a
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
W.Workspace String
i l a
l Maybe (Stack a)
ms)
runLayout (W.Workspace String
i (Choose CLR
CR l a
l r a
r) Maybe (Stack a)
ms) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (r :: * -> *) a.
CLR -> l a -> r a -> Choose l r a
Choose CLR
CR l a
l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
W.Workspace String
i r a
r Maybe (Stack a)
ms)
description :: Choose l r a -> String
description (Choose CLR
CL l a
l r a
_) = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l a
l
description (Choose CLR
CR l a
_ r a
r) = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description r a
r
handleMessage :: Choose l r a -> SomeMessage -> X (Maybe (Choose l r a))
handleMessage Choose l r a
lr SomeMessage
m | Just ChangeLayout
NextLayout <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
Maybe (Choose l r a)
mlr' <- forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle Choose l r a
lr NextNoWrap
NextNoWrap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle Choose l r a
lr ChangeLayout
FirstLayout) (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) Maybe (Choose l r a)
mlr'
handleMessage c :: Choose l r a
c@(Choose CLR
d l a
l r a
r) SomeMessage
m | Just NextNoWrap
NextNoWrap <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
case CLR
d of
CLR
CL -> do
Maybe (l a)
ml <- forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l NextNoWrap
NextNoWrap
case Maybe (l a)
ml of
Just l a
_ -> forall (l :: * -> *) a (r :: * -> *).
(LayoutClass l a, LayoutClass r a) =>
Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose Choose l r a
c CLR
CL Maybe (l a)
ml forall a. Maybe a
Nothing
Maybe (l a)
Nothing -> forall (l :: * -> *) a (r :: * -> *).
(LayoutClass l a, LayoutClass r a) =>
Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose Choose l r a
c CLR
CR forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle r a
r ChangeLayout
FirstLayout
CLR
CR -> forall (l :: * -> *) a (r :: * -> *).
(LayoutClass l a, LayoutClass r a) =>
Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose Choose l r a
c CLR
CR forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle r a
r NextNoWrap
NextNoWrap
handleMessage c :: Choose l r a
c@(Choose CLR
_ l a
l r a
_) SomeMessage
m | Just ChangeLayout
FirstLayout <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (l :: * -> *) a (r :: * -> *).
(LayoutClass l a, LayoutClass r a) =>
Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose Choose l r a
c CLR
CL) forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l ChangeLayout
FirstLayout
handleMessage c :: Choose l r a
c@(Choose CLR
d l a
l r a
r) SomeMessage
m | Just LayoutMessages
ReleaseResources <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (forall (l :: * -> *) a (r :: * -> *).
(LayoutClass l a, LayoutClass r a) =>
Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose Choose l r a
c CLR
d) (forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l LayoutMessages
ReleaseResources) (forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle r a
r LayoutMessages
ReleaseResources)
handleMessage c :: Choose l r a
c@(Choose CLR
d l a
l r a
r) SomeMessage
m | Just e :: Event
e@DestroyWindowEvent{} <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (forall (l :: * -> *) a (r :: * -> *).
(LayoutClass l a, LayoutClass r a) =>
Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose Choose l r a
c CLR
d) (forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l Event
e) (forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle r a
r Event
e)
handleMessage c :: Choose l r a
c@(Choose CLR
d l a
l r a
r) SomeMessage
m | Just (JumpToLayout String
desc) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
Maybe (l a)
ml <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
m
Maybe (r a)
mr <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage r a
r SomeMessage
m
let md :: CLR
md | String
desc forall a. Eq a => a -> a -> Bool
== forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description (forall a. a -> Maybe a -> a
fromMaybe l a
l Maybe (l a)
ml) = CLR
CL
| String
desc forall a. Eq a => a -> a -> Bool
== forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description (forall a. a -> Maybe a -> a
fromMaybe r a
r Maybe (r a)
mr) = CLR
CR
| Bool
otherwise = CLR
d
forall (l :: * -> *) a (r :: * -> *).
(LayoutClass l a, LayoutClass r a) =>
Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose Choose l r a
c CLR
md Maybe (l a)
ml Maybe (r a)
mr
handleMessage c :: Choose l r a
c@(Choose CLR
d l a
l r a
r) SomeMessage
m = do
Maybe (l a)
ml' <- case CLR
d of
CLR
CL -> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
m
CLR
CR -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe (r a)
mr' <- case CLR
d of
CLR
CL -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
CLR
CR -> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage r a
r SomeMessage
m
forall (l :: * -> *) a (r :: * -> *).
(LayoutClass l a, LayoutClass r a) =>
Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose Choose l r a
c CLR
d Maybe (l a)
ml' Maybe (r a)
mr'