{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards         #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ScopedTypeVariables   #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.LayoutBuilder
-- Description :  Send a number of windows to one rectangle and the rest to another.
--
-- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>,
--                    2011 Ilya Portnov <portnov84@rambler.ru>,
--                    2015 Peter Jones <pjones@devalot.com>
--
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Anders Engstrom <ankaan@gmail.com>,
--                Ilya Portnov <portnov84@rambler.ru>,
--                Peter Jones <pjones@devalot.com>
--
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout combinator that sends a specified number of windows to one rectangle
-- and the rest to another. Each of these rectangles are given a layout that
-- is used within them. This can be chained to provide an arbitrary number of
-- rectangles. The layout combinator allows overlapping rectangles, but such
-- layouts does not work well together with hinting
-- ("XMonad.Layout.LayoutHints", "XMonad.Layout.HintedGrid" etc.)
--
-----------------------------------------------------------------------------
module XMonad.Layout.LayoutBuilder (
  -- * Usage
  -- $usage
  layoutN,
  layoutR,
  layoutP,
  layoutAll,

  -- * Selecting Windows
  -- $selectWin
  Predicate (..),
  Proxy(..),

  -- * Messages
  IncLayoutN (..),

  -- * Utilities
  SubMeasure (..),
  SubBox (..),
  absBox,
  relBox,
  LayoutB,
  LayoutN,
) where

import Data.Maybe (maybeToList)
import XMonad
import XMonad.Prelude (foldM, (<|>), isJust, fromMaybe, isNothing, listToMaybe)
import qualified XMonad.StackSet as W
import XMonad.Util.Stack (zipperFocusedAtFirstOf)
import XMonad.Util.WindowProperties

--------------------------------------------------------------------------------
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.LayoutBuilder
--
-- Then edit your @layoutHook@ by adding something like:
--
-- > myLayout = ( (layoutN 1 (relBox 0 0 0.5 1) (Just $ relBox 0 0 1 1) $ simpleTabbed)
-- >             $ (layoutAll (relBox 0.5 0 1 1)                         $ simpleTabbed)
-- >             ) |||
-- >             ( (layoutN 1       (relBox (1/3) 0 (1/2) 1) (Just $ relBox 0 0 1 1) $ Tall 0 0.01 0.5)
-- >             $ (layoutR 0.1 0.5 (relBox (2/3) 0 1     1) Nothing                 $ Tall 0 0.01 0.5)
-- >             $ (layoutAll       (relBox 0     0 (1/3) 1)                         $ Tall 0 0.01 0.5)
-- >             ) |||
-- >             ( (layoutN 1 (absBox (-512-200) 0 512        0) (Just $ relBox 0 0 1 1) $ simpleTabbed)
-- >             $ (layoutN 1 (absBox (-200)     0 0          0) Nothing                 $ simpleTabbed)
-- >             $ (layoutAll (absBox 0          0 (-512-200) 0)                         $ simpleTabbed)
-- >             ) |||
-- >             ( (layoutN 1 (absBox 10 0 0 (-10)) Nothing $ Tall 0 0.01 0.5)
-- >             $ (layoutN 1 (absBox 0 0 200 0) Nothing $ Tall 0 0.01 0.5)
-- >             $ (layoutAll (absBox 10 10 0 0) $ Tall 2 0.01 0.5)
-- >             ) ||| Full ||| etc...
-- > main = xmonad def { layoutHook = myLayout }
--
-- This will produce a layout similar to DragPane, but with the possibility to have multiple windows in the left half
-- and tabs that show the available windows. It will also produce a layout similar to ThreeColMid and a special layout
-- created for use with a 80 columns wide Emacs window, its sidebar and a tabbed area for all other windows.
--
-- The final layout is for applications that use a toolbar in a separate window, shown on a low resolution screen. It has
-- a master area that cover almost the whole screen. It leaves 10 px to the left and 10 px at the bottom. To the left
-- the toolbar is located and can be accessed by focusing this area. It is actually 200 px wide, but usually below the
-- other windows. Similarly all other windows are tiled, but behind the master window and can be accessed by moving the
-- mouse to the bottom of the screen. Everything can also be accessed by the standard focus changing key bindings.
--
-- This module can be used to create many different custom layouts, but there are limitations. The primary limitation
-- can be observed in the second and third example when there are only two columns with windows in them. The leftmost
-- area is left blank. These blank areas can be avoided by placing the rectangles appropriately.
--
-- These examples require "XMonad.Layout.Tabbed".
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
--
-- You may wish to add the following keybindings:
--
-- >    , ((modm .|. shiftMask, xK_h ), sendMessage $ IncLayoutN (-1))
-- >    , ((modm .|. shiftMask, xK_l ), sendMessage $ IncLayoutN 1)
--
-- For detailed instruction on editing the key binding see:
--
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

--------------------------------------------------------------------------------
-- $selectWin
--
-- 'Predicate' exists because layouts are required to be serializable, and
-- "XMonad.Util.WindowProperties" is not sufficient (for example it does not
-- allow using regular expressions).
--
-- compare "XMonad.Util.Invisible"

-- | Type class for predicates. This enables us to manage not only Windows,
-- but any objects, for which instance Predicate is defined.
--
-- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras
class Predicate p w where
  alwaysTrue     :: Proxy w -> p     -- ^ A predicate that is always True.
  checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate

instance Predicate () a where
  alwaysTrue :: Proxy a -> ()
alwaysTrue Proxy a
_       = ()
  checkPredicate :: () -> a -> X Bool
checkPredicate ()
_ a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

instance Predicate Property Window where
  alwaysTrue :: Proxy Window -> Property
alwaysTrue Proxy Window
_   = Bool -> Property
Const Bool
True
  checkPredicate :: Property -> Window -> X Bool
checkPredicate = Property -> Window -> X Bool
hasProperty

--------------------------------------------------------------------------------
-- | Contains no actual data, but is needed to help select the correct instance
-- of 'Predicate'
data Proxy a = Proxy

--------------------------------------------------------------------------------
-- | Information about how to split windows between layouts.
data Limit p = LimitN Int                  -- ^ See: 'layoutN'.
             | LimitR (Rational, Rational) -- ^ See: 'layoutR'.
             | LimitP p                    -- ^ See: 'layoutP'.
             deriving (Int -> Limit p -> ShowS
forall p. Show p => Int -> Limit p -> ShowS
forall p. Show p => [Limit p] -> ShowS
forall p. Show p => Limit p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit p] -> ShowS
$cshowList :: forall p. Show p => [Limit p] -> ShowS
show :: Limit p -> String
$cshow :: forall p. Show p => Limit p -> String
showsPrec :: Int -> Limit p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> Limit p -> ShowS
Show, ReadPrec [Limit p]
ReadPrec (Limit p)
ReadS [Limit p]
forall p. Read p => ReadPrec [Limit p]
forall p. Read p => ReadPrec (Limit p)
forall p. Read p => Int -> ReadS (Limit p)
forall p. Read p => ReadS [Limit p]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Limit p]
$creadListPrec :: forall p. Read p => ReadPrec [Limit p]
readPrec :: ReadPrec (Limit p)
$creadPrec :: forall p. Read p => ReadPrec (Limit p)
readList :: ReadS [Limit p]
$creadList :: forall p. Read p => ReadS [Limit p]
readsPrec :: Int -> ReadS (Limit p)
$creadsPrec :: forall p. Read p => Int -> ReadS (Limit p)
Read)

--------------------------------------------------------------------------------
-- | Use one layout in the specified area for a number of windows and
-- possibly let another layout handle the rest.
data LayoutB l1 l2 p a = LayoutB
    { forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe a
subFocus  :: Maybe a      -- ^ The focused window in this layout.
    , forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe a
nextFocus :: Maybe a      -- ^ The focused window in the next layout.
    , forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Limit p
limit     :: Limit p      -- ^ How to split windows between layouts.
    , forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> SubBox
box       :: SubBox       -- ^ Normal size of layout.
    , forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe SubBox
mbox      :: Maybe SubBox -- ^ Size of layout when handling all windows.
    , forall (l1 :: * -> *) (l2 :: * -> *) p a. LayoutB l1 l2 p a -> l1 a
sub       :: l1 a         -- ^ The layout to use in this box.
    , forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe (l2 a)
next      :: Maybe (l2 a) -- ^ The next layout in the chain.
    } deriving (Int -> LayoutB l1 l2 p a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
Int -> LayoutB l1 l2 p a -> ShowS
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
[LayoutB l1 l2 p a] -> ShowS
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
LayoutB l1 l2 p a -> String
showList :: [LayoutB l1 l2 p a] -> ShowS
$cshowList :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
[LayoutB l1 l2 p a] -> ShowS
show :: LayoutB l1 l2 p a -> String
$cshow :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
LayoutB l1 l2 p a -> String
showsPrec :: Int -> LayoutB l1 l2 p a -> ShowS
$cshowsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
Int -> LayoutB l1 l2 p a -> ShowS
Show, ReadPrec [LayoutB l1 l2 p a]
ReadPrec (LayoutB l1 l2 p a)
ReadS [LayoutB l1 l2 p a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec [LayoutB l1 l2 p a]
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec (LayoutB l1 l2 p a)
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (LayoutB l1 l2 p a)
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadS [LayoutB l1 l2 p a]
readListPrec :: ReadPrec [LayoutB l1 l2 p a]
$creadListPrec :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec [LayoutB l1 l2 p a]
readPrec :: ReadPrec (LayoutB l1 l2 p a)
$creadPrec :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec (LayoutB l1 l2 p a)
readList :: ReadS [LayoutB l1 l2 p a]
$creadList :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadS [LayoutB l1 l2 p a]
readsPrec :: Int -> ReadS (LayoutB l1 l2 p a)
$creadsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (LayoutB l1 l2 p a)
Read)

--------------------------------------------------------------------------------
-- | A variant of 'LayoutB' that can't use 'layoutP'.  For backwards
-- compatibility with previous versions of LayoutBuilder.
type LayoutN l1 l2 a = LayoutB l1 l2 () a

--------------------------------------------------------------------------------
-- | Use the specified layout in the described area for N windows and
-- send the rest of the windows to the next layout in the chain.  It
-- is possible to supply an alternative area that will then be used
-- instead, if there are no windows to send to the next layout.
layoutN :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) =>
       Int                               -- ^ The number of windows to handle
    -> SubBox                            -- ^ The box to place the windows in
    -> Maybe SubBox                      -- ^ Possibly an alternative box that is used when this layout handles all windows that are left
    -> l1 a                              -- ^ The layout to use in the specified area
    -> LayoutB l2 l3 p a                 -- ^ Where to send the remaining windows
    -> LayoutB l1 (LayoutB l2 l3 p) () a -- ^ The resulting layout
layoutN :: forall a (l1 :: * -> *) (l2 :: * -> *) (l3 :: * -> *) p.
(Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a,
 LayoutClass l3 a) =>
Int
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutB l2 l3 p a
-> LayoutB l1 (LayoutB l2 l3 p) () a
layoutN Int
num SubBox
box Maybe SubBox
mbox l1 a
sub LayoutB l2 l3 p a
next = forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall p. Int -> Limit p
LimitN Int
num) SubBox
box Maybe SubBox
mbox l1 a
sub (forall a. a -> Maybe a
Just LayoutB l2 l3 p a
next)

-- | As layoutN, but the number of windows is given relative to the total number of windows remaining to be handled. The first
--   argument is how much to change the ratio when using IncLayoutN, and the second is the initial ratio.
layoutR :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) =>
       Rational                         -- ^ How much to change the ratio with each IncLayoutN
    -> Rational                         -- ^ The ratio of the remaining windows to handle
    -> SubBox                           -- ^ The box to place the windows in
    -> Maybe SubBox                     -- ^ Possibly an alternative box that is used when this layout handles all windows that are left
    -> l1 a                             -- ^ The layout to use in the specified area
    -> LayoutB l2 l3 p a                -- ^ Where to send the remaining windows
    -> LayoutB l1 (LayoutB l2 l3 p) p a -- ^ The resulting layout
layoutR :: forall a (l1 :: * -> *) (l2 :: * -> *) (l3 :: * -> *) p.
(Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a,
 LayoutClass l3 a) =>
Rational
-> Rational
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutB l2 l3 p a
-> LayoutB l1 (LayoutB l2 l3 p) p a
layoutR Rational
numdiff Rational
num SubBox
box Maybe SubBox
mbox l1 a
sub LayoutB l2 l3 p a
next = forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall p. (Rational, Rational) -> Limit p
LimitR (Rational
numdiff,Rational
num)) SubBox
box Maybe SubBox
mbox l1 a
sub (forall a. a -> Maybe a
Just LayoutB l2 l3 p a
next)

--------------------------------------------------------------------------------
-- | Use the specified layout in the described area windows that match
-- given predicate and send the rest of the windows to the next layout
-- in the chain.  It is possible to supply an alternative area that
-- will then be used instead, if there are no windows to send to the
-- next layout.
layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a, Predicate p' a) =>
       p                                 -- ^ The predicate to use
    -> SubBox                            -- ^ The box to place the windows in
    -> Maybe SubBox                      -- ^ Possibly an alternative box that is used when this layout handles all windows that are left
    -> l1 a                              -- ^ The layout to use in the specified area
    -> LayoutB l2 l3 p' a                -- ^ Where to send the remaining windows
    -> LayoutB l1 (LayoutB l2 l3 p') p a -- ^ The resulting layout
layoutP :: forall a (l1 :: * -> *) (l2 :: * -> *) (l3 :: * -> *) p p'.
(Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a,
 LayoutClass l3 a, Predicate p a, Predicate p' a) =>
p
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutB l2 l3 p' a
-> LayoutB l1 (LayoutB l2 l3 p') p a
layoutP p
prop SubBox
box Maybe SubBox
mbox l1 a
sub LayoutB l2 l3 p' a
next = forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall p. p -> Limit p
LimitP p
prop) SubBox
box Maybe SubBox
mbox l1 a
sub (forall a. a -> Maybe a
Just LayoutB l2 l3 p' a
next)

--------------------------------------------------------------------------------
-- | Use the specified layout in the described area for all remaining windows.
layoutAll :: (Read a, Eq a, LayoutClass l1 a) =>
       SubBox                -- ^ The box to place the windows in
    -> l1 a                  -- ^ The layout to use in the specified area
    -> LayoutB l1 Full () a  -- ^ The resulting layout
layoutAll :: forall a (l1 :: * -> *).
(Read a, Eq a, LayoutClass l1 a) =>
SubBox -> l1 a -> LayoutB l1 Full () a
layoutAll SubBox
box l1 a
sub = forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall p. (Rational, Rational) -> Limit p
LimitR (Rational
0,Rational
1)) SubBox
box forall a. Maybe a
Nothing l1 a
sub forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- | Change the number of windows handled by the focused layout.
newtype IncLayoutN = IncLayoutN Int
instance Message IncLayoutN

--------------------------------------------------------------------------------
-- | The absolute or relative measures used to describe the area a layout should be placed in. For negative absolute values
--   the total remaining space will be added. For sizes, the remaining space will also be added for zeroes. Relative values
--   are applied on the remaining space after the top-left corner of the box have been removed.
data SubMeasure = Abs Int | Rel Rational deriving (Int -> SubMeasure -> ShowS
[SubMeasure] -> ShowS
SubMeasure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubMeasure] -> ShowS
$cshowList :: [SubMeasure] -> ShowS
show :: SubMeasure -> String
$cshow :: SubMeasure -> String
showsPrec :: Int -> SubMeasure -> ShowS
$cshowsPrec :: Int -> SubMeasure -> ShowS
Show,ReadPrec [SubMeasure]
ReadPrec SubMeasure
Int -> ReadS SubMeasure
ReadS [SubMeasure]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubMeasure]
$creadListPrec :: ReadPrec [SubMeasure]
readPrec :: ReadPrec SubMeasure
$creadPrec :: ReadPrec SubMeasure
readList :: ReadS [SubMeasure]
$creadList :: ReadS [SubMeasure]
readsPrec :: Int -> ReadS SubMeasure
$creadsPrec :: Int -> ReadS SubMeasure
Read)

--------------------------------------------------------------------------------
-- | A box to place a layout in. The stored values are xpos, ypos, width and height.
data SubBox = SubBox SubMeasure SubMeasure SubMeasure SubMeasure deriving (Int -> SubBox -> ShowS
[SubBox] -> ShowS
SubBox -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubBox] -> ShowS
$cshowList :: [SubBox] -> ShowS
show :: SubBox -> String
$cshow :: SubBox -> String
showsPrec :: Int -> SubBox -> ShowS
$cshowsPrec :: Int -> SubBox -> ShowS
Show,ReadPrec [SubBox]
ReadPrec SubBox
Int -> ReadS SubBox
ReadS [SubBox]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubBox]
$creadListPrec :: ReadPrec [SubBox]
readPrec :: ReadPrec SubBox
$creadPrec :: ReadPrec SubBox
readList :: ReadS [SubBox]
$creadList :: ReadS [SubBox]
readsPrec :: Int -> ReadS SubBox
$creadsPrec :: Int -> ReadS SubBox
Read)

--------------------------------------------------------------------------------
-- | Create a box with only absolute measurements. If the values are negative, the total remaining space will be added. For
--   sizes it will also be added for zeroes.
absBox :: Int     -- ^ Absolute X-Position
       -> Int     -- ^ Absolute Y-Position
       -> Int     -- ^ Absolute width
       -> Int     -- ^ Absolute height
       -> SubBox  -- ^ The resulting 'SubBox' describing the area
absBox :: Int -> Int -> Int -> Int -> SubBox
absBox Int
x Int
y Int
w Int
h = SubMeasure -> SubMeasure -> SubMeasure -> SubMeasure -> SubBox
SubBox (Int -> SubMeasure
Abs Int
x) (Int -> SubMeasure
Abs Int
y) (Int -> SubMeasure
Abs Int
w) (Int -> SubMeasure
Abs Int
h)

--------------------------------------------------------------------------------
-- | Create a box with only relative measurements.
relBox :: Rational  -- ^ Relative X-Position with respect to the surrounding area
       -> Rational  -- ^ Relative Y-Position with respect to the surrounding area
       -> Rational  -- ^ Relative width with respect to the remaining width
       -> Rational  -- ^ Relative height with respect to the remaining height
       -> SubBox    -- ^ The resulting 'SubBox' describing the area
relBox :: Rational -> Rational -> Rational -> Rational -> SubBox
relBox Rational
x Rational
y Rational
w Rational
h = SubMeasure -> SubMeasure -> SubMeasure -> SubMeasure -> SubBox
SubBox (Rational -> SubMeasure
Rel Rational
x) (Rational -> SubMeasure
Rel Rational
y) (Rational -> SubMeasure
Rel Rational
w) (Rational -> SubMeasure
Rel Rational
h)

--------------------------------------------------------------------------------
instance ( LayoutClass l1 a, LayoutClass l2 a
         , Read a, Show a, Show p, Typeable p, Eq a, Typeable a, Predicate p a
         ) => LayoutClass (LayoutB l1 l2 p) a where

    -- | Update window locations.
    runLayout :: Workspace String (LayoutB l1 l2 p a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (LayoutB l1 l2 p a))
runLayout (W.Workspace String
_ LayoutB {l1 a
Maybe a
Maybe (l2 a)
Maybe SubBox
SubBox
Limit p
next :: Maybe (l2 a)
sub :: l1 a
mbox :: Maybe SubBox
box :: SubBox
limit :: Limit p
nextFocus :: Maybe a
subFocus :: Maybe a
next :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe (l2 a)
sub :: forall (l1 :: * -> *) (l2 :: * -> *) p a. LayoutB l1 l2 p a -> l1 a
mbox :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe SubBox
box :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> SubBox
limit :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Limit p
nextFocus :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe a
subFocus :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe a
..} Maybe (Stack a)
s) Rectangle
rect = do
        (Maybe (Stack a)
subs, Maybe (Stack a)
nexts, Maybe a
subFocus', Maybe a
nextFocus') <- forall a p.
(Eq a, Predicate p a) =>
Maybe (Stack a)
-> Limit p
-> Maybe a
-> Maybe a
-> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitStack Maybe (Stack a)
s Limit p
limit Maybe a
subFocus Maybe a
nextFocus

        let selBox :: SubBox
selBox = if forall a. Maybe a -> Bool
isJust Maybe a
nextFocus' then SubBox
box else forall a. a -> Maybe a -> a
fromMaybe SubBox
box Maybe SubBox
mbox

        ([(a, Rectangle)]
sublist, l1 a
sub', Bool
schange) <- forall {layout :: * -> *} {a}.
LayoutClass layout a =>
layout a
-> Maybe (Stack a)
-> Rectangle
-> X ([(a, Rectangle)], layout a, Bool)
handle l1 a
sub Maybe (Stack a)
subs (SubBox -> Rectangle -> Rectangle
calcArea SubBox
selBox Rectangle
rect)

        ([(a, Rectangle)]
nextlist, Maybe (l2 a)
next', Bool
nchange) <- case Maybe (l2 a)
next of
          Maybe (l2 a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing, Bool
False)
          Just l2 a
n  -> do ([(a, Rectangle)]
res, l2 a
l, Bool
ch) <- forall {layout :: * -> *} {a}.
LayoutClass layout a =>
layout a
-> Maybe (Stack a)
-> Rectangle
-> X ([(a, Rectangle)], layout a, Bool)
handle l2 a
n Maybe (Stack a)
nexts Rectangle
rect
                        forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
res, forall a. a -> Maybe a
Just l2 a
l, Bool
ch)

        let newlist :: [(a, Rectangle)]
newlist =  if forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. Stack a -> [a]
W.up Maybe (Stack a)
s) forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack a)
subs)
                         then [(a, Rectangle)]
sublistforall a. [a] -> [a] -> [a]
++[(a, Rectangle)]
nextlist
                         else [(a, Rectangle)]
nextlistforall a. [a] -> [a] -> [a]
++[(a, Rectangle)]
sublist

            newstate :: Maybe (LayoutB l1 l2 p a)
newstate = if Maybe a
subFocus' forall a. Eq a => a -> a -> Bool
/= Maybe a
subFocus Bool -> Bool -> Bool
|| Maybe a
nextFocus' forall a. Eq a => a -> a -> Bool
/= Maybe a
nextFocus Bool -> Bool -> Bool
|| Bool
schange Bool -> Bool -> Bool
|| Bool
nchange
                         then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
subFocus' Maybe a
nextFocus' Limit p
limit SubBox
box Maybe SubBox
mbox l1 a
sub' Maybe (l2 a)
next'
                         else forall a. Maybe a
Nothing

        forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
newlist, Maybe (LayoutB l1 l2 p a)
newstate)
      where
          handle :: layout a
-> Maybe (Stack a)
-> Rectangle
-> X ([(a, Rectangle)], layout a, Bool)
handle layout a
l Maybe (Stack a)
s' Rectangle
r = do ([(a, Rectangle)]
res,Maybe (layout a)
ml) <- 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
"" layout a
l Maybe (Stack a)
s') Rectangle
r
                             forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
res, forall a. a -> Maybe a -> a
fromMaybe layout a
l Maybe (layout a)
ml, forall a. Maybe a -> Bool
isNothing Maybe (layout a)
ml)

    -- |  Propagate messages.
    handleMessage :: LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
handleMessage LayoutB l1 l2 p a
l SomeMessage
m
        | Just (IncLayoutN Int
n) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a
-> SomeMessage -> Int -> X (Maybe (LayoutB l1 l2 p a))
incLayoutN LayoutB l1 l2 p a
l SomeMessage
m Int
n
        | Just (IncMasterN Int
_) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendFocus  LayoutB l1 l2 p a
l SomeMessage
m
        | Just Resize
Shrink         <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendFocus  LayoutB l1 l2 p a
l SomeMessage
m
        | Just Resize
Expand         <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendFocus  LayoutB l1 l2 p a
l SomeMessage
m
        | Bool
otherwise                            = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendBoth   LayoutB l1 l2 p a
l SomeMessage
m

    -- | Descriptive name for layout.
    description :: LayoutB l1 l2 p a -> String
description LayoutB l1 l2 p a
layout = case LayoutB l1 l2 p a
layout of
        (LayoutB Maybe a
_ Maybe a
_ Limit p
_ SubBox
_ Maybe SubBox
_ l1 a
sub Maybe (l2 a)
Nothing) ->
          String
"layoutAll " forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
sub

        (LayoutB Maybe a
_ Maybe a
_ (LimitN Int
_) SubBox
_ Maybe SubBox
_ l1 a
sub (Just l2 a
next)) ->
          String
"layoutN " forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
sub forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 a
next

        (LayoutB Maybe a
_ Maybe a
_ (LimitR (Rational, Rational)
_) SubBox
_ Maybe SubBox
_ l1 a
sub (Just l2 a
next)) ->
          String
"layoutR " forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
sub forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 a
next

        (LayoutB Maybe a
_ Maybe a
_ (LimitP p
_) SubBox
_ Maybe SubBox
_ l1 a
sub (Just l2 a
next)) ->
          String
"layoutP " forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
sub forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 a
next

--------------------------------------------------------------------------------
-- | Increase the number of windows allowed in the focused layout.
incLayoutN :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
           => LayoutB l1 l2 p a
           -> SomeMessage
           -> Int
           -> X (Maybe (LayoutB l1 l2 p a))
incLayoutN :: forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a
-> SomeMessage -> Int -> X (Maybe (LayoutB l1 l2 p a))
incLayoutN layout :: LayoutB l1 l2 p a
layout@LayoutB {l1 a
Maybe a
Maybe (l2 a)
Maybe SubBox
SubBox
Limit p
next :: Maybe (l2 a)
sub :: l1 a
mbox :: Maybe SubBox
box :: SubBox
limit :: Limit p
nextFocus :: Maybe a
subFocus :: Maybe a
next :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe (l2 a)
sub :: forall (l1 :: * -> *) (l2 :: * -> *) p a. LayoutB l1 l2 p a -> l1 a
mbox :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe SubBox
box :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> SubBox
limit :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Limit p
nextFocus :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe a
subFocus :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe a
..} SomeMessage
message Int
n = do
    Bool
incThis <- forall a. Show a => Maybe a -> X Bool
isFocus Maybe a
subFocus

    if Bool
incThis
       then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just LayoutB l1 l2 p a
layout { limit :: Limit p
limit = Limit p
newLimit }
       else forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendNext LayoutB l1 l2 p a
layout SomeMessage
message

  where
    newLimit :: Limit p
newLimit = case Limit p
limit of
      LimitN Int
oldnum         -> forall p. Int -> Limit p
LimitN (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ Int
oldnum forall a. Num a => a -> a -> a
+ Int
n)
      LimitR (Rational
diff, Rational
oldnum) -> forall p. (Rational, Rational) -> Limit p
LimitR (Rational
diff, forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Rational
0 forall a b. (a -> b) -> a -> b
$ Rational
oldnum forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Num a => a -> a -> a
* Rational
diff)
      LimitP p
_              -> Limit p
limit

--------------------------------------------------------------------------------
sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendSub :: forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendSub (LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num SubBox
box Maybe SubBox
mbox l1 a
sub Maybe (l2 a)
next) SomeMessage
m =
    do Maybe (l1 a)
sub' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
sub SomeMessage
m
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isJust Maybe (l1 a)
sub'
                then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num SubBox
box Maybe SubBox
mbox (forall a. a -> Maybe a -> a
fromMaybe l1 a
sub Maybe (l1 a)
sub') Maybe (l2 a)
next
                else forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendBoth :: forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendBoth l :: LayoutB l1 l2 p a
l@(LayoutB Maybe a
_ Maybe a
_ Limit p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
Nothing) SomeMessage
m = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendSub LayoutB l1 l2 p a
l SomeMessage
m
sendBoth (LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num SubBox
box Maybe SubBox
mbox l1 a
sub (Just l2 a
next)) SomeMessage
m =
    do Maybe (l1 a)
sub' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
sub SomeMessage
m
       Maybe (l2 a)
next' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
next SomeMessage
m
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isJust Maybe (l1 a)
sub' Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (l2 a)
next'
                then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num SubBox
box Maybe SubBox
mbox (forall a. a -> Maybe a -> a
fromMaybe l1 a
sub Maybe (l1 a)
sub') (Maybe (l2 a)
next' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just l2 a
next)
                else forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendNext :: forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendNext (LayoutB Maybe a
_ Maybe a
_ Limit p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
Nothing) SomeMessage
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
sendNext (LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num SubBox
box Maybe SubBox
mbox l1 a
sub (Just l2 a
next)) SomeMessage
m =
    do Maybe (l2 a)
next' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
next SomeMessage
m
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isJust Maybe (l2 a)
next'
                then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num SubBox
box Maybe SubBox
mbox l1 a
sub Maybe (l2 a)
next'
                else forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendFocus :: forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendFocus l :: LayoutB l1 l2 p a
l@(LayoutB Maybe a
subFocus Maybe a
_ Limit p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
_) SomeMessage
m = do
  Bool
foc <- forall a. Show a => Maybe a -> X Bool
isFocus Maybe a
subFocus

  if Bool
foc
    then forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendSub  LayoutB l1 l2 p a
l SomeMessage
m
    else forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendNext LayoutB l1 l2 p a
l SomeMessage
m

--------------------------------------------------------------------------------
-- | Check to see if the given window is currently focused.
isFocus :: (Show a) => Maybe a -> X Bool
isFocus :: forall a. Show a => Maybe a -> X Bool
isFocus Maybe a
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isFocus (Just a
w) = do Maybe (Stack Window)
ms <- forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Stack Window
s -> forall a. Show a => a -> String
show a
w forall a. Eq a => a -> a -> Bool
== forall a. Show a => a -> String
show (forall a. Stack a -> a
W.focus Stack Window
s)) Maybe (Stack Window)
ms

--------------------------------------------------------------------------------
calcNum :: Int -> Limit p -> Int
calcNum :: forall p. Int -> Limit p -> Int
calcNum Int
tot Limit p
num = forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ case Limit p
num of LimitN Int
i     -> Int
i
                                      LimitR (Rational
_,Rational
r) -> forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ Rational
r forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tot
                                      LimitP p
_     -> Int
1

--------------------------------------------------------------------------------
-- | Split given list of objects (i.e. windows) using predicate.
splitBy :: (Predicate p a) => p -> [a] -> X ([a], [a])
splitBy :: forall p a. Predicate p a => p -> [a] -> X ([a], [a])
splitBy p
prop = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {a}. Predicate p a => ([a], [a]) -> a -> X ([a], [a])
step ([], [])
  where
    step :: ([a], [a]) -> a -> X ([a], [a])
step ([a]
good, [a]
bad) a
w = do
      Bool
ok <- forall p w. Predicate p w => p -> w -> X Bool
checkPredicate p
prop a
w
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
ok
                then (a
wforall a. a -> [a] -> [a]
:[a]
good, [a]
bad)
                else ([a]
good,   a
wforall a. a -> [a] -> [a]
:[a]
bad)

--------------------------------------------------------------------------------
splitStack :: forall a p. (Eq a, Predicate p a)
           => Maybe (W.Stack a) -- ^ Window set.
           -> Limit p           -- ^ How to split the stack.
           -> Maybe a           -- ^ The window that was focused in this layout.
           -> Maybe a           -- ^ The window that was focused in the next layout.
           -> X (Maybe (W.Stack a), Maybe (W.Stack a), Maybe a, Maybe a)
splitStack :: forall a p.
(Eq a, Predicate p a) =>
Maybe (Stack a)
-> Limit p
-> Maybe a
-> Maybe a
-> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitStack Maybe (Stack a)
Nothing Limit p
_ Maybe a
_ Maybe a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
splitStack (Just Stack a
s) Limit p
limit Maybe a
subFocus Maybe a
nextFocus =
  case Limit p
limit of
    LimitN Int
_    -> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitN
    LimitR (Rational, Rational)
_    -> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitN
    LimitP p
prop -> forall {p}.
Predicate p a =>
p -> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitP p
prop

  where
    ws :: [a]
ws        = forall a. Stack a -> [a]
W.integrate Stack a
s
    n :: Int
n         = forall p. Int -> Limit p -> Int
calcNum (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws) Limit p
limit
    subl :: [a]
subl      = forall a. Int -> [a] -> [a]
take Int
n [a]
ws
    nextl :: [a]
nextl     = forall a. Int -> [a] -> [a]
drop Int
n [a]
ws
    subFocus' :: [a] -> Maybe a
subFocus' [a]
xs  = [a] -> Maybe a -> Maybe a
foc [a]
xs Maybe a
subFocus
    nextFocus' :: [a] -> Maybe a
nextFocus' [a]
xs = [a] -> Maybe a -> Maybe a
foc [a]
xs Maybe a
nextFocus

    -- Pick a new focused window if necessary.
    foc :: [a] -> Maybe a -> Maybe a
    foc :: [a] -> Maybe a -> Maybe a
foc [] Maybe a
_                           = forall a. Maybe a
Nothing
    foc [a]
l Maybe a
f | forall a. Stack a -> a
W.focus Stack a
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
l       = forall a. a -> Maybe a
Just (forall a. Stack a -> a
W.focus Stack a
s)
            | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
l) Maybe a
f = Maybe a
f
            | Bool
otherwise                = forall a. [a] -> Maybe a
listToMaybe [a]
l

    -- Split based on max number of windows.
    splitN :: X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitN = forall (m :: * -> *) a. Monad m => a -> m a
return ( forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' ([a] -> Maybe a
subFocus' [a]
subl)   [a]
subl
                    , forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' ([a] -> Maybe a
nextFocus' [a]
nextl) [a]
nextl
                    , [a] -> Maybe a
subFocus'  [a]
subl
                    , [a] -> Maybe a
nextFocus' [a]
nextl
                    )

    -- Split based on a predicate.
    splitP :: p -> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitP p
prop = do
      ([a]
this, [a]
other) <- forall p a. Predicate p a => p -> [a] -> X ([a], [a])
splitBy p
prop [a]
ws
      forall (m :: * -> *) a. Monad m => a -> m a
return ( forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' ([a] -> Maybe a
subFocus' [a]
this)   [a]
this
             , forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' ([a] -> Maybe a
nextFocus' [a]
other) [a]
other
             , [a] -> Maybe a
subFocus' [a]
this
             , [a] -> Maybe a
nextFocus' [a]
other
             )

--------------------------------------------------------------------------------
calcArea :: SubBox -> Rectangle -> Rectangle
calcArea :: SubBox -> Rectangle -> Rectangle
calcArea (SubBox SubMeasure
xpos SubMeasure
ypos SubMeasure
width SubMeasure
height) Rectangle
rect =
    Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Rectangle -> Position
rect_x Rectangle
rect forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
xpos')
              (Rectangle -> Position
rect_y Rectangle
rect forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
ypos')
              Dimension
width' Dimension
height'
  where
    xpos' :: Dimension
xpos' = forall {a} {b}. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
False SubMeasure
xpos forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
rect
    ypos' :: Dimension
ypos' = forall {a} {b}. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
False SubMeasure
ypos forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_height Rectangle
rect
    width' :: Dimension
width' = forall {a} {b}. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
True SubMeasure
width forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
rect forall a. Num a => a -> a -> a
- Dimension
xpos'
    height' :: Dimension
height' = forall {a} {b}. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
True SubMeasure
height forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_height Rectangle
rect forall a. Num a => a -> a -> a
- Dimension
ypos'

    calc :: Bool -> SubMeasure -> a -> b
calc Bool
zneg SubMeasure
val a
tot = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tot) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$
        case SubMeasure
val of Rel Rational
v -> forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Rational
v forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tot
                    Abs Int
v -> if Int
vforall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| (Bool
zneg Bool -> Bool -> Bool
&& Int
vforall a. Eq a => a -> a -> Bool
==Int
0)
                               then forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tot forall a. Num a => a -> a -> a
+ Int
v
                               else Int
v

--------------------------------------------------------------------------------
differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)
differentiate' :: forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> [a]
maybeToList