{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}

-- --------------------------------------------------------------------------
-- |
-- 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.
newtype 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
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

-- | The builtin tiling mode of xmonad. Supports 'Shrink', 'Expand' and
-- 'IncMasterN'.
data Tall a = Tall { forall a. Tall a -> Int
tallNMaster :: !Int               -- ^ The default number of windows in the master pane (default: 1)
                   , forall a. Tall a -> Rational
tallRatioIncrement :: !Rational   -- ^ Percent of screen to increment by when resizing panes (default: 3/100)
                   , forall a. Tall a -> Rational
tallRatio :: !Rational            -- ^ Default proportion of screen occupied by master pane (default: 1/2)
                   }
                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)
                        -- 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
        | 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"

-- | 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 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 -- two columns
  where (Rectangle
r1,Rectangle
r2) = 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 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 --hmm, this is a fold or map.

-- Not used in the core, but exported
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

-- Divide the screen into two rectangles, using a rational to specify the ratio
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

-- Not used in the core, but exported
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

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

-- | Mirror a layout, compute its 90 degree rotated form.
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

-- | 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
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

-- | 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
||| :: 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 |||

-- | 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)
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)

-- | Choose the current sub-layout (left or right) in 'Choose'.
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

-- | 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 :: 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)

-- | 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 :: 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'