{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable, LambdaCase, MultiWayIf #-}

-- --------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout
-- Copyright   :  (c) Spencer Janssen 2007
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  spencerjanssen@gmail.com
-- Stability   :  unstable
-- Portability :  not portable, mtl, posix
--
-- The collection of core layouts.
--
-----------------------------------------------------------------------------

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)

------------------------------------------------------------------------

-- | Change the size of the master pane.
data Resize     = Shrink | Expand

-- | Increase the number of clients in the master pane.
data IncMasterN = IncMasterN !Int

instance Message Resize
instance Message IncMasterN

-- | Simple fullscreen mode. Renders the focused window fullscreen.
data Full a = Full deriving (Int -> Full a -> ShowS
[Full a] -> ShowS
Full a -> String
(Int -> Full a -> ShowS)
-> (Full a -> String) -> ([Full a] -> ShowS) -> Show (Full a)
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)
Int -> ReadS (Full a)
ReadS [Full a]
(Int -> ReadS (Full a))
-> ReadS [Full a]
-> ReadPrec (Full a)
-> ReadPrec [Full a]
-> Read (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

-- | The builtin tiling mode of xmonad. Supports 'Shrink', 'Expand' and
-- 'IncMasterN'.
data Tall a = Tall { Tall a -> Int
tallNMaster :: !Int               -- ^ The default number of windows in the master pane (default: 1)
                   , Tall a -> Rational
tallRatioIncrement :: !Rational   -- ^ Percent of screen to increment by when resizing panes (default: 3/100)
                   , Tall a -> Rational
tallRatio :: !Rational            -- ^ Default proportion of screen occupied by master pane (default: 1/2)
                   }
                deriving (Int -> Tall a -> ShowS
[Tall a] -> ShowS
Tall a -> String
(Int -> Tall a -> ShowS)
-> (Tall a -> String) -> ([Tall a] -> ShowS) -> Show (Tall a)
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)
Int -> ReadS (Tall a)
ReadS [Tall a]
(Int -> ReadS (Tall a))
-> ReadS [Tall a]
-> ReadPrec (Tall a)
-> ReadPrec [Tall a]
-> Read (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)
                        -- TODO should be capped [0..1] ..

-- a nice pure layout, lots of properties for the layout, and its messages, in Properties.hs
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 = [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rs
      where ws :: [a]
ws = Stack a -> [a]
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 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws)

    pureMessage :: Tall a -> SomeMessage -> Maybe (Tall a)
pureMessage (Tall Int
nmaster Rational
delta Rational
frac) SomeMessage
m =
            [Maybe (Tall a)] -> Maybe (Tall a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(Resize -> Tall a) -> Maybe Resize -> Maybe (Tall a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> Tall a
forall a. Resize -> Tall a
resize     (SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                 ,(IncMasterN -> Tall a) -> Maybe IncMasterN -> Maybe (Tall a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IncMasterN -> Tall a
forall a. IncMasterN -> Tall a
incmastern (SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]

      where resize :: Resize -> Tall a
resize Resize
Shrink             = Int -> Rational -> Rational -> Tall a
forall a. Int -> Rational -> Rational -> Tall a
Tall Int
nmaster Rational
delta (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0 (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
fracRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
delta)
            resize Resize
Expand             = Int -> Rational -> Rational -> Tall a
forall a. Int -> Rational -> Rational -> Tall a
Tall Int
nmaster Rational
delta (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
fracRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
delta)
            incmastern :: IncMasterN -> Tall a
incmastern (IncMasterN Int
d) = Int -> Rational -> Rational -> Tall a
forall a. Int -> Rational -> Rational -> Tall a
Tall (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
nmasterInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)) Rational
delta Rational
frac

    description :: Tall a -> String
description Tall a
_ = String
"Tall"

-- | Compute the positions for windows using the default two-pane tiling
-- algorithm.
--
-- The screen is divided into two panes. All clients are
-- then partitioned between these two panes. One pane, the master, by
-- convention has the least number of windows in it.
tile
    :: Rational  -- ^ @frac@, what proportion of the screen to devote to the master area
    -> Rectangle -- ^ @r@, the rectangle representing the screen
    -> Int       -- ^ @nmaster@, the number of windows in the master pane
    -> Int       -- ^ @n@, the total number of windows to tile
    -> [Rectangle]
tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
f Rectangle
r Int
nmaster Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nmaster Bool -> Bool -> Bool
|| Int
nmaster Int -> Int -> Bool
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 [Rectangle] -> [Rectangle] -> [Rectangle]
forall a. [a] -> [a] -> [a]
++ Int -> Rectangle -> [Rectangle]
splitVertically (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nmaster) Rectangle
r2 -- two columns
  where (Rectangle
r1,Rectangle
r2) = Rational -> Rectangle -> (Rectangle, Rectangle)
forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
f Rectangle
r

--
-- Divide the screen vertically into n subrectangles
--
splitVertically, splitHorizontally :: Int -> Rectangle -> [Rectangle]
splitVertically :: Int -> Rectangle -> [Rectangle]
splitVertically Int
n Rectangle
r | Int
n Int -> Int -> Bool
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 Rectangle -> [Rectangle] -> [Rectangle]
forall a. a -> [a] -> [a]
:
    Int -> Rectangle -> [Rectangle]
splitVertically (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
syPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
smallh) Dimension
sw (Dimension
shDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension
smallh))
  where smallh :: Dimension
smallh = Dimension
sh Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n --hmm, this is a fold or map.

-- Not used in the core, but exported
splitHorizontally :: Int -> Rectangle -> [Rectangle]
splitHorizontally Int
n = (Rectangle -> Rectangle) -> [Rectangle] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Rectangle
mirrorRect ([Rectangle] -> [Rectangle])
-> (Rectangle -> [Rectangle]) -> Rectangle -> [Rectangle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rectangle -> [Rectangle]
splitVertically Int
n (Rectangle -> [Rectangle])
-> (Rectangle -> Rectangle) -> Rectangle -> [Rectangle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> Rectangle
mirrorRect

-- Divide the screen into two rectangles, using a rational to specify the ratio
splitHorizontallyBy, splitVerticallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy :: 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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
leftw) Position
sy (Dimension
swDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
leftw) Dimension
sh)
  where leftw :: Dimension
leftw = r -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
floor (r -> Dimension) -> r -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> r
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw r -> r -> r
forall a. Num a => a -> a -> a
* r
f

-- Not used in the core, but exported
splitVerticallyBy :: r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy r
f = (Rectangle -> Rectangle
mirrorRect (Rectangle -> Rectangle)
-> (Rectangle -> Rectangle)
-> (Rectangle, Rectangle)
-> (Rectangle, Rectangle)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Rectangle -> Rectangle
mirrorRect) ((Rectangle, Rectangle) -> (Rectangle, Rectangle))
-> (Rectangle -> (Rectangle, Rectangle))
-> Rectangle
-> (Rectangle, Rectangle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Rectangle -> (Rectangle, Rectangle)
forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy r
f (Rectangle -> (Rectangle, Rectangle))
-> (Rectangle -> Rectangle) -> Rectangle -> (Rectangle, Rectangle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> Rectangle
mirrorRect

------------------------------------------------------------------------

-- | Mirror a layout, compute its 90 degree rotated form.
newtype Mirror l a = Mirror (l a) deriving (Int -> Mirror l a -> ShowS
[Mirror l a] -> ShowS
Mirror l a -> String
(Int -> Mirror l a -> ShowS)
-> (Mirror l a -> String)
-> ([Mirror l a] -> ShowS)
-> Show (Mirror l a)
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)
Int -> ReadS (Mirror l a)
ReadS [Mirror l a]
(Int -> ReadS (Mirror l a))
-> ReadS [Mirror l a]
-> ReadPrec (Mirror l a)
-> ReadPrec [Mirror l a]
-> Read (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 = (((a, Rectangle) -> (a, Rectangle))
-> [(a, Rectangle)] -> [(a, Rectangle)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rectangle -> Rectangle) -> (a, Rectangle) -> (a, Rectangle)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Rectangle -> Rectangle
mirrorRect) ([(a, Rectangle)] -> [(a, Rectangle)])
-> (Maybe (l a) -> Maybe (Mirror l a))
-> ([(a, Rectangle)], Maybe (l a))
-> ([(a, Rectangle)], Maybe (Mirror l a))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (l a -> Mirror l a) -> Maybe (l a) -> Maybe (Mirror l a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap l a -> Mirror l a
forall (l :: * -> *) a. l a -> Mirror l a
Mirror)
                                                (([(a, Rectangle)], Maybe (l a))
 -> ([(a, Rectangle)], Maybe (Mirror l a)))
-> X ([(a, Rectangle)], Maybe (l a))
-> X ([(a, Rectangle)], Maybe (Mirror l a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Workspace String (l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> l a -> Maybe (Stack a) -> Workspace String (l a) a
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) = (Maybe (l a) -> Maybe (Mirror l a))
-> X (Maybe (l a)) -> X (Maybe (Mirror l a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((l a -> Mirror l a) -> Maybe (l a) -> Maybe (Mirror l a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap l a -> Mirror l a
forall (l :: * -> *) a. l a -> Mirror l a
Mirror) (X (Maybe (l a)) -> X (Maybe (Mirror l a)))
-> (SomeMessage -> X (Maybe (l a)))
-> SomeMessage
-> X (Maybe (Mirror l a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l a -> SomeMessage -> X (Maybe (l a))
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 "String -> ShowS
forall a. [a] -> [a] -> [a]
++ l a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l a
l

-- | Mirror a rectangle.
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

------------------------------------------------------------------------
-- LayoutClass selection manager
-- Layouts that transition between other layouts

-- | Messages to change the current layout.  Also see 'JumpToLayout'.
data ChangeLayout = FirstLayout | NextLayout deriving (ChangeLayout -> ChangeLayout -> Bool
(ChangeLayout -> ChangeLayout -> Bool)
-> (ChangeLayout -> ChangeLayout -> Bool) -> Eq ChangeLayout
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
(Int -> ChangeLayout -> ShowS)
-> (ChangeLayout -> String)
-> ([ChangeLayout] -> ShowS)
-> Show ChangeLayout
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

-- | A message to jump to a particular layout, specified by its
-- description string.
--
-- The argument given to a 'JumpToLayout' message should be the
-- @description@ of the layout to be selected.  If you use
-- "XMonad.Hooks.DynamicLog" from @xmonad-contrib@, this is the name of
-- the layout displayed in your status bar.  Alternatively, you can use
-- GHCi to determine the proper name to use.  For example:
--
-- > $ ghci
-- > GHCi, version 6.8.2: http://www.haskell.org/ghc/  :? for help
-- > Loading package base ... linking ... done.
-- > :set prompt "> "    -- don't show loaded module names
-- > > :m +XMonad.Core   -- load the xmonad core
-- > > :m +XMonad.Layout.Grid  -- load whatever module you want to use
-- > > description Grid  -- find out what it's called
-- > "Grid"
--
-- As yet another (possibly easier) alternative, you can use the
-- "XMonad.Layout.Renamed" module (also in @xmonad-contrib@) to give
-- custom names to your layouts, and use those.
--
-- For example, if you want to jump directly to the 'Full' layout you
-- can do
--
-- > , ((modm .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full")
--
newtype JumpToLayout = JumpToLayout String
instance Message JumpToLayout

-- | The layout choice combinator
(|||) :: l a -> r a -> Choose l r a
||| :: l a -> r a -> Choose l r a
(|||) = CLR -> 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 |||

-- | A layout that allows users to switch between various layout options.
data Choose l r a = Choose CLR (l a) (r a) deriving (ReadPrec [Choose l r a]
ReadPrec (Choose l r a)
Int -> ReadS (Choose l r a)
ReadS [Choose l r a]
(Int -> ReadS (Choose l r a))
-> ReadS [Choose l r a]
-> ReadPrec (Choose l r a)
-> ReadPrec [Choose l r a]
-> Read (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
[Choose l r a] -> ShowS
Choose l r a -> String
(Int -> Choose l r a -> ShowS)
-> (Choose l r a -> String)
-> ([Choose l r a] -> ShowS)
-> Show (Choose l r a)
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)

-- | Choose the current sub-layout (left or right) in 'Choose'.
data CLR = CL | CR deriving (ReadPrec [CLR]
ReadPrec CLR
Int -> ReadS CLR
ReadS [CLR]
(Int -> ReadS CLR)
-> ReadS [CLR] -> ReadPrec CLR -> ReadPrec [CLR] -> Read 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
(Int -> CLR -> ShowS)
-> (CLR -> String) -> ([CLR] -> ShowS) -> Show CLR
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
(CLR -> CLR -> Bool) -> (CLR -> CLR -> Bool) -> Eq CLR
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
(NextNoWrap -> NextNoWrap -> Bool)
-> (NextNoWrap -> NextNoWrap -> Bool) -> Eq NextNoWrap
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
(Int -> NextNoWrap -> ShowS)
-> (NextNoWrap -> String)
-> ([NextNoWrap] -> ShowS)
-> Show NextNoWrap
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

-- | A small wrapper around handleMessage, as it is tedious to write
-- SomeMessage repeatedly.
handle :: (LayoutClass l a, Message m) => l a -> m -> X (Maybe (l a))
handle :: l a -> m -> X (Maybe (l a))
handle l a
l m
m = l a -> SomeMessage -> X (Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l (m -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage m
m)

-- | A smart constructor that takes some potential modifications, returns a
-- new structure if any fields have changed, and performs any necessary cleanup
-- on newly non-visible layouts.
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 :: 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 CLR -> CLR -> Bool
forall a. Eq a => a -> a -> Bool
== CLR
d' = Maybe (Choose l r a) -> X (Maybe (Choose l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Choose l r a)
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 = (X (l a), X (r a)) -> X (Maybe (Choose l r a))
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') = (l a -> Maybe (l a) -> l a
forall a. a -> Maybe a -> a
fromMaybe l a
l Maybe (l a)
ml, r a -> Maybe (r a) -> r a
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) -> (l a -> X (l a)
forall (l :: * -> *) a. LayoutClass l a => l a -> X (l a)
hide l a
l'  , r a -> X (r a)
forall (m :: * -> *) a. Monad m => a -> m a
return r a
r')
                    (CLR
CR, CLR
CL) -> (l a -> X (l a)
forall (m :: * -> *) a. Monad m => a -> m a
return l a
l', r a -> X (r a)
forall (l :: * -> *) a. LayoutClass l a => l a -> X (l a)
hide r a
r'  )
                    (CLR
_ , CLR
_ ) -> (l a -> X (l a)
forall (m :: * -> *) a. Monad m => a -> m a
return l a
l', r a -> X (r a)
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)  = (Choose l r a -> Maybe (Choose l r a))
-> f (Choose l r a) -> f (Maybe (Choose l r a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Choose l r a -> Maybe (Choose l r a)
forall a. a -> Maybe a
Just (f (Choose l r a) -> f (Maybe (Choose l r a)))
-> f (Choose l r a) -> f (Maybe (Choose l r a))
forall a b. (a -> b) -> a -> b
$ (l a -> r a -> Choose l r a)
-> f (l a) -> f (r a) -> f (Choose l r a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (CLR -> l a -> r a -> Choose l r a
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   = (Maybe (l a) -> l a) -> X (Maybe (l a)) -> X (l a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (l a -> Maybe (l a) -> l a
forall a. a -> Maybe a -> a
fromMaybe l a
x) (X (Maybe (l a)) -> X (l a)) -> X (Maybe (l a)) -> X (l a)
forall a b. (a -> b) -> a -> b
$ l a -> LayoutMessages -> X (Maybe (l a))
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) =
        (([(a, Rectangle)], Maybe (l a))
 -> ([(a, Rectangle)], Maybe (Choose l r a)))
-> X ([(a, Rectangle)], Maybe (l a))
-> X ([(a, Rectangle)], Maybe (Choose l r a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (l a) -> Maybe (Choose l r a))
-> ([(a, Rectangle)], Maybe (l a))
-> ([(a, Rectangle)], Maybe (Choose l r a))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Maybe (l a) -> Maybe (Choose l r a))
 -> ([(a, Rectangle)], Maybe (l a))
 -> ([(a, Rectangle)], Maybe (Choose l r a)))
-> ((l a -> Choose l r a) -> Maybe (l a) -> Maybe (Choose l r a))
-> (l a -> Choose l r a)
-> ([(a, Rectangle)], Maybe (l a))
-> ([(a, Rectangle)], Maybe (Choose l r a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (l a -> Choose l r a) -> Maybe (l a) -> Maybe (Choose l r a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((l a -> Choose l r a)
 -> ([(a, Rectangle)], Maybe (l a))
 -> ([(a, Rectangle)], Maybe (Choose l r a)))
-> (l a -> Choose l r a)
-> ([(a, Rectangle)], Maybe (l a))
-> ([(a, Rectangle)], Maybe (Choose l r a))
forall a b. (a -> b) -> a -> b
$ (l a -> r a -> Choose l r a) -> r a -> l a -> Choose l r a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CLR -> l a -> r a -> Choose l r a
forall (l :: * -> *) (r :: * -> *) a.
CLR -> l a -> r a -> Choose l r a
Choose CLR
CL) r a
r) (X ([(a, Rectangle)], Maybe (l a))
 -> X ([(a, Rectangle)], Maybe (Choose l r a)))
-> (Rectangle -> X ([(a, Rectangle)], Maybe (l a)))
-> Rectangle
-> X ([(a, Rectangle)], Maybe (Choose l r a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> l a -> Maybe (Stack a) -> Workspace String (l a) a
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) =
        (([(a, Rectangle)], Maybe (r a))
 -> ([(a, Rectangle)], Maybe (Choose l r a)))
-> X ([(a, Rectangle)], Maybe (r a))
-> X ([(a, Rectangle)], Maybe (Choose l r a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (r a) -> Maybe (Choose l r a))
-> ([(a, Rectangle)], Maybe (r a))
-> ([(a, Rectangle)], Maybe (Choose l r a))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Maybe (r a) -> Maybe (Choose l r a))
 -> ([(a, Rectangle)], Maybe (r a))
 -> ([(a, Rectangle)], Maybe (Choose l r a)))
-> ((r a -> Choose l r a) -> Maybe (r a) -> Maybe (Choose l r a))
-> (r a -> Choose l r a)
-> ([(a, Rectangle)], Maybe (r a))
-> ([(a, Rectangle)], Maybe (Choose l r a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r a -> Choose l r a) -> Maybe (r a) -> Maybe (Choose l r a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r a -> Choose l r a)
 -> ([(a, Rectangle)], Maybe (r a))
 -> ([(a, Rectangle)], Maybe (Choose l r a)))
-> (r a -> Choose l r a)
-> ([(a, Rectangle)], Maybe (r a))
-> ([(a, Rectangle)], Maybe (Choose l r a))
forall a b. (a -> b) -> a -> b
$ CLR -> l a -> r a -> Choose l r a
forall (l :: * -> *) (r :: * -> *) a.
CLR -> l a -> r a -> Choose l r a
Choose CLR
CR l a
l) (X ([(a, Rectangle)], Maybe (r a))
 -> X ([(a, Rectangle)], Maybe (Choose l r a)))
-> (Rectangle -> X ([(a, Rectangle)], Maybe (r a)))
-> Rectangle
-> X ([(a, Rectangle)], Maybe (Choose l r a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (r a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (r a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> r a -> Maybe (Stack a) -> Workspace String (r a) a
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
_) = l a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l a
l
    description (Choose CLR
CR l a
_ r a
r) = r a -> String
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 <- SomeMessage -> Maybe ChangeLayout
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
        Maybe (Choose l r a)
mlr' <- Choose l r a -> NextNoWrap -> X (Maybe (Choose l r a))
forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle Choose l r a
lr NextNoWrap
NextNoWrap
        X (Maybe (Choose l r a))
-> (Choose l r a -> X (Maybe (Choose l r a)))
-> Maybe (Choose l r a)
-> X (Maybe (Choose l r a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Choose l r a -> ChangeLayout -> X (Maybe (Choose l r a))
forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle Choose l r a
lr ChangeLayout
FirstLayout) (Maybe (Choose l r a) -> X (Maybe (Choose l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Choose l r a) -> X (Maybe (Choose l r a)))
-> (Choose l r a -> Maybe (Choose l r a))
-> Choose l r a
-> X (Maybe (Choose l r a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choose l r a -> Maybe (Choose l r a)
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 <- SomeMessage -> Maybe NextNoWrap
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        case CLR
d of
            CLR
CL -> do
                Maybe (l a)
ml <- l a -> NextNoWrap -> X (Maybe (l a))
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
_  -> Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r 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 Maybe (r a)
forall a. Maybe a
Nothing
                    Maybe (l a)
Nothing -> Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r 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
CR Maybe (l a)
forall a. Maybe a
Nothing (Maybe (r a) -> X (Maybe (Choose l r a)))
-> X (Maybe (r a)) -> X (Maybe (Choose l r a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< r a -> ChangeLayout -> X (Maybe (r a))
forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle r a
r ChangeLayout
FirstLayout

            CLR
CR -> Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r 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
CR Maybe (l a)
forall a. Maybe a
Nothing (Maybe (r a) -> X (Maybe (Choose l r a)))
-> X (Maybe (r a)) -> X (Maybe (Choose l r a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< r a -> NextNoWrap -> X (Maybe (r a))
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 <- SomeMessage -> Maybe ChangeLayout
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        (Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a)))
-> Maybe (r a) -> Maybe (l a) -> X (Maybe (Choose l r a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r 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 (r a)
forall a. Maybe a
Nothing (Maybe (l a) -> X (Maybe (Choose l r a)))
-> X (Maybe (l a)) -> X (Maybe (Choose l r a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< l a -> ChangeLayout -> X (Maybe (l a))
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 <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        X (X (Maybe (Choose l r a))) -> X (Maybe (Choose l r a))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (X (Maybe (Choose l r a))) -> X (Maybe (Choose l r a)))
-> X (X (Maybe (Choose l r a))) -> X (Maybe (Choose l r a))
forall a b. (a -> b) -> a -> b
$ (Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a)))
-> X (Maybe (l a))
-> X (Maybe (r a))
-> X (X (Maybe (Choose l r a)))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r 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
d) (l a -> LayoutMessages -> X (Maybe (l a))
forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l LayoutMessages
ReleaseResources) (r a -> LayoutMessages -> X (Maybe (r a))
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{} <- SomeMessage -> Maybe Event
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        X (X (Maybe (Choose l r a))) -> X (Maybe (Choose l r a))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (X (Maybe (Choose l r a))) -> X (Maybe (Choose l r a)))
-> X (X (Maybe (Choose l r a))) -> X (Maybe (Choose l r a))
forall a b. (a -> b) -> a -> b
$ (Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a)))
-> X (Maybe (l a))
-> X (Maybe (r a))
-> X (X (Maybe (Choose l r a)))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r 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
d) (l a -> Event -> X (Maybe (l a))
forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l Event
e) (r a -> Event -> X (Maybe (r a))
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) <- SomeMessage -> Maybe JumpToLayout
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
        Maybe (l a)
ml <- l a -> SomeMessage -> X (Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
m
        Maybe (r a)
mr <- r a -> SomeMessage -> X (Maybe (r a))
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== l a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description (l a -> Maybe (l a) -> l a
forall a. a -> Maybe a -> a
fromMaybe l a
l Maybe (l a)
ml) = CLR
CL
               | String
desc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== r a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description (r a -> Maybe (r a) -> r a
forall a. a -> Maybe a -> a
fromMaybe r a
r Maybe (r a)
mr) = CLR
CR
               | Bool
otherwise = CLR
d
        Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r 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
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 -> l a -> SomeMessage -> X (Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
m
                CLR
CR -> Maybe (l a) -> X (Maybe (l a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (l a)
forall a. Maybe a
Nothing
        Maybe (r a)
mr' <- case CLR
d of
                CLR
CL -> Maybe (r a) -> X (Maybe (r a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (r a)
forall a. Maybe a
Nothing
                CLR
CR -> r a -> SomeMessage -> X (Maybe (r a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage r a
r SomeMessage
m
        Choose l r a
-> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r 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
d Maybe (l a)
ml' Maybe (r a)
mr'