-- {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
---------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.TallMastersCombo
-- Description :  A version of @Tall@ with two permanent master windows.
-- Copyright   :  (c) 2019 Ningji Wei
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Ningji Wei <tidues@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout combinator that support Shrink, Expand, and IncMasterN just as the
-- 'Tall' layout, and also support operations of two master windows:
-- a main master, which is the original master window;
-- a sub master, the first window of the second pane.
-- This combinator can be nested, and has a good support for using
-- 'XMonad.Layout.Tabbed' as a sublayout.
--
-----------------------------------------------------------------------------

module XMonad.Layout.TallMastersCombo (
  -- * Usage
  -- $usage
  tmsCombineTwoDefault,
  tmsCombineTwo,
  TMSCombineTwo (..),
  RowsOrColumns (..),
  (|||),

  -- * Messages
  SwitchOrientation (..),
  SwapSubMaster (..),
  FocusSubMaster (..), FocusedNextLayout (..), ChangeFocus (..),

  -- * Utilities
  ChooseWrapper (..),
  swapWindow,
  focusWindow,
  handleMessages
) where

import XMonad hiding (focus, (|||))
import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust)
import XMonad.StackSet (Workspace(..),integrate',Stack(..))
import qualified XMonad.StackSet as W
import qualified XMonad.Layout as LL
import XMonad.Layout.Simplest (Simplest(..))
import XMonad.Layout.Decoration

---------------------------------------------------------------------------------
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.TallMastersCombo
--
-- and make sure the Choose layout operator (|||) is hidden by adding the followings:
--
-- > import XMonad hiding ((|||))
-- > import XMonad.Layout hiding ((|||))
--
-- then, add something like
--
-- > tmsCombineTwoDefault (Tall 0 (3/100) 0) simpleTabbed
--
-- This will make the 'Tall' layout as the master pane, and 'simpleTabbed' layout as the second pane.
-- You can shrink, expand, and increase more windows to the master pane just like using the
-- 'Tall' layout.
--
-- To swap and/or focus the sub master window (the first window in the second pane), you can add
-- the following key bindings
--
-- >      , ((modm .|. shiftMask, m),         sendMessage $ FocusSubMaster)
-- >      , ((modm .|. shiftMask, xK_Return), sendMessage $ SwapSubMaster)
--
-- In each pane, you can use multiple layouts with the '(|||)' combinator provided by this module,
-- and switch between them with the 'FocusedNextLayout' message. Below is one example
--
-- > layout1 = Simplest ||| Tabbed
-- > layout2 = Full ||| Tabbed ||| (RowsOrColumns True)
-- > myLayout = tmsCombineTwoDefault layout1 layout2
--
-- then add the following key binding,
--
-- >      , ((modm, w), sendMessage $ FocusedNextLayout)
--
-- Now, pressing this key will toggle the multiple layouts in the currently focused pane.
--
-- You can mirror this layout with the default 'Mirror' key binding. But to have a more natural
-- behaviors, you can use the 'SwitchOrientation' message:
--
-- >      , ((modm, xK_space), sendMessage $ SwitchOrientation)
--
-- This will not mirror the tabbed decoration, and will keep sub-layouts that made by TallMastersCombo
-- and RowsOrColumns display in natural orientations.
--
-- To merge layouts more flexibly, you can use 'tmsCombineTwo' instead.
--
-- > tmsCombineTwo False 1 (3/100) (1/3) Simplest simpleTabbed
--
-- This creates a vertical merged layout with 1 window in the master pane, and the master pane shrinks
-- and expands with a step of (3\/100), and occupies (1\/3) of the screen.
--
-- Each sub-layout have a focused window. To rotate between the focused windows across all the
-- sub-layouts, using the following messages:
--
-- >      , ((modm .|. mod1, j), sendMessage $ NextFocus)
-- >      , ((modm .|. mod1, k), sendMessage $ PrevFocus)
--
-- this let you jump to the focused window in the next/previous sub-layout.
--
--
-- Finally, this combinator can be nested. Here is one example,
--
-- @
-- subLayout  = tmsCombineTwo False 1 (3\/100) (1\/2) Simplest simpleTabbed
-- layout1    = simpleTabbed ||| subLayout
-- layout2    = subLayout ||| simpleTabbed ||| (RowsOrColumns True)
-- baseLayout = tmsCombineTwoDefault layout1 layout2
--
-- mylayouts = smartBorders $
--             avoidStruts $
--             mkToggle (FULL ?? EOT) $
--             baseLayout
-- @
--
-- this is a realization of the cool idea from
--
-- <https://www.reddit.com/r/xmonad/comments/3vkrc3/does_this_layout_exist_if_not_can_anyone_suggest/>
--
-- and is more flexible.
--

-- | A simple layout that arranges windows in a row or a column with equal sizes.
-- It can switch between row mode and column mode by listening to the message 'SwitchOrientation'.
newtype RowsOrColumns a = RowsOrColumns { RowsOrColumns a -> Bool
rowMode :: Bool -- ^ arrange windows in rows or columns
                                        } deriving (Int -> RowsOrColumns a -> ShowS
[RowsOrColumns a] -> ShowS
RowsOrColumns a -> String
(Int -> RowsOrColumns a -> ShowS)
-> (RowsOrColumns a -> String)
-> ([RowsOrColumns a] -> ShowS)
-> Show (RowsOrColumns a)
forall a. Int -> RowsOrColumns a -> ShowS
forall a. [RowsOrColumns a] -> ShowS
forall a. RowsOrColumns a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowsOrColumns a] -> ShowS
$cshowList :: forall a. [RowsOrColumns a] -> ShowS
show :: RowsOrColumns a -> String
$cshow :: forall a. RowsOrColumns a -> String
showsPrec :: Int -> RowsOrColumns a -> ShowS
$cshowsPrec :: forall a. Int -> RowsOrColumns a -> ShowS
Show, ReadPrec [RowsOrColumns a]
ReadPrec (RowsOrColumns a)
Int -> ReadS (RowsOrColumns a)
ReadS [RowsOrColumns a]
(Int -> ReadS (RowsOrColumns a))
-> ReadS [RowsOrColumns a]
-> ReadPrec (RowsOrColumns a)
-> ReadPrec [RowsOrColumns a]
-> Read (RowsOrColumns a)
forall a. ReadPrec [RowsOrColumns a]
forall a. ReadPrec (RowsOrColumns a)
forall a. Int -> ReadS (RowsOrColumns a)
forall a. ReadS [RowsOrColumns a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RowsOrColumns a]
$creadListPrec :: forall a. ReadPrec [RowsOrColumns a]
readPrec :: ReadPrec (RowsOrColumns a)
$creadPrec :: forall a. ReadPrec (RowsOrColumns a)
readList :: ReadS [RowsOrColumns a]
$creadList :: forall a. ReadS [RowsOrColumns a]
readsPrec :: Int -> ReadS (RowsOrColumns a)
$creadsPrec :: forall a. Int -> ReadS (RowsOrColumns a)
Read)

instance LayoutClass RowsOrColumns a where
  description :: RowsOrColumns a -> String
description (RowsOrColumns Bool
rows) =
    if Bool
rows then String
"Rows" else String
"Columns"

  pureLayout :: RowsOrColumns a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (RowsOrColumns Bool
rows) 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
          len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
          rs :: [Rectangle]
rs = if Bool
rows
               then Int -> Rectangle -> [Rectangle]
splitVertically Int
len Rectangle
r
               else Int -> Rectangle -> [Rectangle]
splitHorizontally Int
len Rectangle
r

  pureMessage :: RowsOrColumns a -> SomeMessage -> Maybe (RowsOrColumns a)
pureMessage RowsOrColumns{} SomeMessage
m
    | Just Orientation
Row <- SomeMessage -> Maybe Orientation
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = RowsOrColumns a -> Maybe (RowsOrColumns a)
forall a. a -> Maybe a
Just (RowsOrColumns a -> Maybe (RowsOrColumns a))
-> RowsOrColumns a -> Maybe (RowsOrColumns a)
forall a b. (a -> b) -> a -> b
$ Bool -> RowsOrColumns a
forall a. Bool -> RowsOrColumns a
RowsOrColumns Bool
True
    | Just Orientation
Col <- SomeMessage -> Maybe Orientation
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = RowsOrColumns a -> Maybe (RowsOrColumns a)
forall a. a -> Maybe a
Just (RowsOrColumns a -> Maybe (RowsOrColumns a))
-> RowsOrColumns a -> Maybe (RowsOrColumns a)
forall a b. (a -> b) -> a -> b
$ Bool -> RowsOrColumns a
forall a. Bool -> RowsOrColumns a
RowsOrColumns Bool
False
    | Bool
otherwise = Maybe (RowsOrColumns a)
forall a. Maybe a
Nothing


data TMSCombineTwo l1 l2 a =
  TMSCombineTwo { TMSCombineTwo l1 l2 a -> [a]
focusLst :: [a]
                , TMSCombineTwo l1 l2 a -> [a]
ws1 :: [a]
                , TMSCombineTwo l1 l2 a -> [a]
ws2 :: [a]
                , TMSCombineTwo l1 l2 a -> Bool
rowMod :: Bool  -- ^ merge two layouts in a column or a row
                , TMSCombineTwo l1 l2 a -> Int
nMaster :: !Int     -- ^ number of windows in the master pane
                , TMSCombineTwo l1 l2 a -> Rational
rationInc :: !Rational -- ^ percent of screen to increment by when resizing panes
                , TMSCombineTwo l1 l2 a -> Rational
tallComboRatio :: !Rational -- ^ default proportion of screen occupied by master pane
                , TMSCombineTwo l1 l2 a -> l1 a
layoutFst :: l1 a  -- ^ layout for the master pane
                , TMSCombineTwo l1 l2 a -> l2 a
layoutSnd :: l2 a  -- ^ layout for the second pane
                }
        deriving (Int -> TMSCombineTwo l1 l2 a -> ShowS
[TMSCombineTwo l1 l2 a] -> ShowS
TMSCombineTwo l1 l2 a -> String
(Int -> TMSCombineTwo l1 l2 a -> ShowS)
-> (TMSCombineTwo l1 l2 a -> String)
-> ([TMSCombineTwo l1 l2 a] -> ShowS)
-> Show (TMSCombineTwo l1 l2 a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
Int -> TMSCombineTwo l1 l2 a -> ShowS
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
[TMSCombineTwo l1 l2 a] -> ShowS
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
TMSCombineTwo l1 l2 a -> String
showList :: [TMSCombineTwo l1 l2 a] -> ShowS
$cshowList :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
[TMSCombineTwo l1 l2 a] -> ShowS
show :: TMSCombineTwo l1 l2 a -> String
$cshow :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
TMSCombineTwo l1 l2 a -> String
showsPrec :: Int -> TMSCombineTwo l1 l2 a -> ShowS
$cshowsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show (l1 a), Show (l2 a)) =>
Int -> TMSCombineTwo l1 l2 a -> ShowS
Show, ReadPrec [TMSCombineTwo l1 l2 a]
ReadPrec (TMSCombineTwo l1 l2 a)
Int -> ReadS (TMSCombineTwo l1 l2 a)
ReadS [TMSCombineTwo l1 l2 a]
(Int -> ReadS (TMSCombineTwo l1 l2 a))
-> ReadS [TMSCombineTwo l1 l2 a]
-> ReadPrec (TMSCombineTwo l1 l2 a)
-> ReadPrec [TMSCombineTwo l1 l2 a]
-> Read (TMSCombineTwo l1 l2 a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadPrec [TMSCombineTwo l1 l2 a]
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadPrec (TMSCombineTwo l1 l2 a)
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (TMSCombineTwo l1 l2 a)
forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadS [TMSCombineTwo l1 l2 a]
readListPrec :: ReadPrec [TMSCombineTwo l1 l2 a]
$creadListPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadPrec [TMSCombineTwo l1 l2 a]
readPrec :: ReadPrec (TMSCombineTwo l1 l2 a)
$creadPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadPrec (TMSCombineTwo l1 l2 a)
readList :: ReadS [TMSCombineTwo l1 l2 a]
$creadList :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
ReadS [TMSCombineTwo l1 l2 a]
readsPrec :: Int -> ReadS (TMSCombineTwo l1 l2 a)
$creadsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (TMSCombineTwo l1 l2 a)
Read)

-- | Combine two layouts l1 l2 with default behaviors.
tmsCombineTwoDefault :: (LayoutClass l1 Window, LayoutClass l2 Window) =>
                          l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window
tmsCombineTwoDefault :: l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window
tmsCombineTwoDefault = [Window]
-> [Window]
-> [Window]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [] [] [] Bool
True Int
1 (Rational
3Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
100) (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)

-- | A more flexible way of merging two layouts. User can specify if merge them vertical or horizontal,
-- the number of windows in the first pane (master pane), the shink and expand increment, and the proportion
-- occupied by the master pane.
tmsCombineTwo :: (LayoutClass l1 Window, LayoutClass l2 Window) =>
                  Bool -> Int -> Rational -> Rational -> l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window
tmsCombineTwo :: Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
tmsCombineTwo = [Window]
-> [Window]
-> [Window]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [] [] []

data Orientation = Row | Col deriving (ReadPrec [Orientation]
ReadPrec Orientation
Int -> ReadS Orientation
ReadS [Orientation]
(Int -> ReadS Orientation)
-> ReadS [Orientation]
-> ReadPrec Orientation
-> ReadPrec [Orientation]
-> Read Orientation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Orientation]
$creadListPrec :: ReadPrec [Orientation]
readPrec :: ReadPrec Orientation
$creadPrec :: ReadPrec Orientation
readList :: ReadS [Orientation]
$creadList :: ReadS [Orientation]
readsPrec :: Int -> ReadS Orientation
$creadsPrec :: Int -> ReadS Orientation
Read, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> Orientation -> ShowS
Show)
instance Message Orientation

-- | A message that switches the orientation of TallMasterCombo layout and the RowsOrColumns layout.
-- This is similar to the 'Mirror' message, but 'Mirror' cannot apply to hidden layouts, and when 'Mirror'
-- applies to the 'XMonad.Layout.Tabbed' decoration, it will also mirror the tabs, which may lead to unintended
-- visualizations. The 'SwitchOrientation' message refreshes layouts according to the orientation of the parent layout,
-- and will not affect the 'XMonad.Layout.Tabbed' decoration.
data SwitchOrientation = SwitchOrientation deriving (ReadPrec [SwitchOrientation]
ReadPrec SwitchOrientation
Int -> ReadS SwitchOrientation
ReadS [SwitchOrientation]
(Int -> ReadS SwitchOrientation)
-> ReadS [SwitchOrientation]
-> ReadPrec SwitchOrientation
-> ReadPrec [SwitchOrientation]
-> Read SwitchOrientation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwitchOrientation]
$creadListPrec :: ReadPrec [SwitchOrientation]
readPrec :: ReadPrec SwitchOrientation
$creadPrec :: ReadPrec SwitchOrientation
readList :: ReadS [SwitchOrientation]
$creadList :: ReadS [SwitchOrientation]
readsPrec :: Int -> ReadS SwitchOrientation
$creadsPrec :: Int -> ReadS SwitchOrientation
Read, Int -> SwitchOrientation -> ShowS
[SwitchOrientation] -> ShowS
SwitchOrientation -> String
(Int -> SwitchOrientation -> ShowS)
-> (SwitchOrientation -> String)
-> ([SwitchOrientation] -> ShowS)
-> Show SwitchOrientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwitchOrientation] -> ShowS
$cshowList :: [SwitchOrientation] -> ShowS
show :: SwitchOrientation -> String
$cshow :: SwitchOrientation -> String
showsPrec :: Int -> SwitchOrientation -> ShowS
$cshowsPrec :: Int -> SwitchOrientation -> ShowS
Show)
instance Message SwitchOrientation

-- | This message swaps the current focused window with the sub master window (first window in the second pane).
data SwapSubMaster = SwapSubMaster deriving (ReadPrec [SwapSubMaster]
ReadPrec SwapSubMaster
Int -> ReadS SwapSubMaster
ReadS [SwapSubMaster]
(Int -> ReadS SwapSubMaster)
-> ReadS [SwapSubMaster]
-> ReadPrec SwapSubMaster
-> ReadPrec [SwapSubMaster]
-> Read SwapSubMaster
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwapSubMaster]
$creadListPrec :: ReadPrec [SwapSubMaster]
readPrec :: ReadPrec SwapSubMaster
$creadPrec :: ReadPrec SwapSubMaster
readList :: ReadS [SwapSubMaster]
$creadList :: ReadS [SwapSubMaster]
readsPrec :: Int -> ReadS SwapSubMaster
$creadsPrec :: Int -> ReadS SwapSubMaster
Read, Int -> SwapSubMaster -> ShowS
[SwapSubMaster] -> ShowS
SwapSubMaster -> String
(Int -> SwapSubMaster -> ShowS)
-> (SwapSubMaster -> String)
-> ([SwapSubMaster] -> ShowS)
-> Show SwapSubMaster
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwapSubMaster] -> ShowS
$cshowList :: [SwapSubMaster] -> ShowS
show :: SwapSubMaster -> String
$cshow :: SwapSubMaster -> String
showsPrec :: Int -> SwapSubMaster -> ShowS
$cshowsPrec :: Int -> SwapSubMaster -> ShowS
Show)
instance Message SwapSubMaster

-- | This message changes the focus to the sub master window (first window in the second pane).
data FocusSubMaster = FocusSubMaster deriving (ReadPrec [FocusSubMaster]
ReadPrec FocusSubMaster
Int -> ReadS FocusSubMaster
ReadS [FocusSubMaster]
(Int -> ReadS FocusSubMaster)
-> ReadS [FocusSubMaster]
-> ReadPrec FocusSubMaster
-> ReadPrec [FocusSubMaster]
-> Read FocusSubMaster
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FocusSubMaster]
$creadListPrec :: ReadPrec [FocusSubMaster]
readPrec :: ReadPrec FocusSubMaster
$creadPrec :: ReadPrec FocusSubMaster
readList :: ReadS [FocusSubMaster]
$creadList :: ReadS [FocusSubMaster]
readsPrec :: Int -> ReadS FocusSubMaster
$creadsPrec :: Int -> ReadS FocusSubMaster
Read, Int -> FocusSubMaster -> ShowS
[FocusSubMaster] -> ShowS
FocusSubMaster -> String
(Int -> FocusSubMaster -> ShowS)
-> (FocusSubMaster -> String)
-> ([FocusSubMaster] -> ShowS)
-> Show FocusSubMaster
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocusSubMaster] -> ShowS
$cshowList :: [FocusSubMaster] -> ShowS
show :: FocusSubMaster -> String
$cshow :: FocusSubMaster -> String
showsPrec :: Int -> FocusSubMaster -> ShowS
$cshowsPrec :: Int -> FocusSubMaster -> ShowS
Show)
instance Message FocusSubMaster

-- | This message triggers the 'NextLayout' message in the pane that contains the focused window.
data FocusedNextLayout = FocusedNextLayout deriving (ReadPrec [FocusedNextLayout]
ReadPrec FocusedNextLayout
Int -> ReadS FocusedNextLayout
ReadS [FocusedNextLayout]
(Int -> ReadS FocusedNextLayout)
-> ReadS [FocusedNextLayout]
-> ReadPrec FocusedNextLayout
-> ReadPrec [FocusedNextLayout]
-> Read FocusedNextLayout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FocusedNextLayout]
$creadListPrec :: ReadPrec [FocusedNextLayout]
readPrec :: ReadPrec FocusedNextLayout
$creadPrec :: ReadPrec FocusedNextLayout
readList :: ReadS [FocusedNextLayout]
$creadList :: ReadS [FocusedNextLayout]
readsPrec :: Int -> ReadS FocusedNextLayout
$creadsPrec :: Int -> ReadS FocusedNextLayout
Read, Int -> FocusedNextLayout -> ShowS
[FocusedNextLayout] -> ShowS
FocusedNextLayout -> String
(Int -> FocusedNextLayout -> ShowS)
-> (FocusedNextLayout -> String)
-> ([FocusedNextLayout] -> ShowS)
-> Show FocusedNextLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocusedNextLayout] -> ShowS
$cshowList :: [FocusedNextLayout] -> ShowS
show :: FocusedNextLayout -> String
$cshow :: FocusedNextLayout -> String
showsPrec :: Int -> FocusedNextLayout -> ShowS
$cshowsPrec :: Int -> FocusedNextLayout -> ShowS
Show)
instance Message FocusedNextLayout

-- | This is a message for changing to the previous or next focused window across all the sub-layouts.
data ChangeFocus = NextFocus | PrevFocus deriving (ReadPrec [ChangeFocus]
ReadPrec ChangeFocus
Int -> ReadS ChangeFocus
ReadS [ChangeFocus]
(Int -> ReadS ChangeFocus)
-> ReadS [ChangeFocus]
-> ReadPrec ChangeFocus
-> ReadPrec [ChangeFocus]
-> Read ChangeFocus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangeFocus]
$creadListPrec :: ReadPrec [ChangeFocus]
readPrec :: ReadPrec ChangeFocus
$creadPrec :: ReadPrec ChangeFocus
readList :: ReadS [ChangeFocus]
$creadList :: ReadS [ChangeFocus]
readsPrec :: Int -> ReadS ChangeFocus
$creadsPrec :: Int -> ReadS ChangeFocus
Read, Int -> ChangeFocus -> ShowS
[ChangeFocus] -> ShowS
ChangeFocus -> String
(Int -> ChangeFocus -> ShowS)
-> (ChangeFocus -> String)
-> ([ChangeFocus] -> ShowS)
-> Show ChangeFocus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeFocus] -> ShowS
$cshowList :: [ChangeFocus] -> ShowS
show :: ChangeFocus -> String
$cshow :: ChangeFocus -> String
showsPrec :: Int -> ChangeFocus -> ShowS
$cshowsPrec :: Int -> ChangeFocus -> ShowS
Show)
instance Message ChangeFocus

-- instance (Typeable l1, Typeable l2, LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (TMSCombineTwo l1 l2) Window where
instance (GetFocused l1 Window, GetFocused l2 Window) => LayoutClass (TMSCombineTwo l1 l2) Window where
  description :: TMSCombineTwo l1 l2 Window -> String
description TMSCombineTwo l1 l2 Window
_ = String
"TallMasters"

  runLayout :: Workspace String (TMSCombineTwo l1 l2 Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (TMSCombineTwo l1 l2 Window))
runLayout (Workspace String
wid (TMSCombineTwo [Window]
f [Window]
_ [Window]
_ Bool
vsp Int
nmaster Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2) Maybe (Stack Window)
s) Rectangle
r =
      let (Maybe (Stack Window)
s1,Maybe (Stack Window)
s2,Rational
frac',[Window]
slst1,[Window]
slst2) = [Window]
-> Int
-> Rational
-> Maybe (Stack Window)
-> (Maybe (Stack Window), Maybe (Stack Window), Rational, [Window],
    [Window])
forall a.
Eq a =>
[a]
-> Int
-> Rational
-> Maybe (Stack a)
-> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])
splitStack [Window]
f Int
nmaster Rational
frac Maybe (Stack Window)
s
          (Rectangle
r1, Rectangle
r2) = if Bool
vsp
                     then Rational -> Rectangle -> (Rectangle, Rectangle)
forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
frac' Rectangle
r
                     else Rational -> Rectangle -> (Rectangle, Rectangle)
forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy Rational
frac' Rectangle
r
      in
      do
         ([(Window, Rectangle)]
ws , Maybe (l1 Window)
ml ) <- Workspace String (l1 Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l1 Window
-> Maybe (Stack Window)
-> Workspace String (l1 Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
wid l1 Window
layout1 Maybe (Stack Window)
s1) Rectangle
r1
         ([(Window, Rectangle)]
ws', Maybe (l2 Window)
ml') <- Workspace String (l2 Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l2 Window
-> Maybe (Stack Window)
-> Workspace String (l2 Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
wid l2 Window
layout2 Maybe (Stack Window)
s2) Rectangle
r2
         let newlayout1 :: l1 Window
newlayout1 = l1 Window -> Maybe (l1 Window) -> l1 Window
forall a. a -> Maybe a -> a
fromMaybe l1 Window
layout1 Maybe (l1 Window)
ml
             newlayout2 :: l2 Window
newlayout2 = l2 Window -> Maybe (l2 Window) -> l2 Window
forall a. a -> Maybe a -> a
fromMaybe l2 Window
layout2 Maybe (l2 Window)
ml'
             ([Window]
f1, String
_) = l1 Window -> Maybe (Stack Window) -> ([Window], String)
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused l1 Window
newlayout1 Maybe (Stack Window)
s1
             ([Window]
f2, String
_) = l2 Window -> Maybe (Stack Window) -> ([Window], String)
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused l2 Window
newlayout2 Maybe (Stack Window)
s2
             fnew :: [Window]
fnew = [Window]
f1 [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
f2
         ([(Window, Rectangle)], Maybe (TMSCombineTwo l1 l2 Window))
-> X ([(Window, Rectangle)], Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
ws[(Window, Rectangle)]
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. [a] -> [a] -> [a]
++[(Window, Rectangle)]
ws', TMSCombineTwo l1 l2 Window -> Maybe (TMSCombineTwo l1 l2 Window)
forall a. a -> Maybe a
Just (TMSCombineTwo l1 l2 Window -> Maybe (TMSCombineTwo l1 l2 Window))
-> TMSCombineTwo l1 l2 Window -> Maybe (TMSCombineTwo l1 l2 Window)
forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window]
-> [Window]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
fnew [Window]
slst1 [Window]
slst2 Bool
vsp Int
nmaster Rational
delta Rational
frac l1 Window
newlayout1 l2 Window
newlayout2)


  handleMessage :: TMSCombineTwo l1 l2 Window
-> SomeMessage -> X (Maybe (TMSCombineTwo l1 l2 Window))
handleMessage i :: TMSCombineTwo l1 l2 Window
i@(TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 Bool
vsp Int
nmaster Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2) SomeMessage
m
    -- messages that only traverse one level
    | Just Resize
Shrink <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TMSCombineTwo l1 l2 Window)
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> (TMSCombineTwo l1 l2 Window
    -> Maybe (TMSCombineTwo l1 l2 Window))
-> TMSCombineTwo l1 l2 Window
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMSCombineTwo l1 l2 Window -> Maybe (TMSCombineTwo l1 l2 Window)
forall a. a -> Maybe a
Just (TMSCombineTwo l1 l2 Window
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> TMSCombineTwo l1 l2 Window
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window]
-> [Window]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 Bool
vsp 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) l1 Window
layout1 l2 Window
layout2
    | Just Resize
Expand <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TMSCombineTwo l1 l2 Window)
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> (TMSCombineTwo l1 l2 Window
    -> Maybe (TMSCombineTwo l1 l2 Window))
-> TMSCombineTwo l1 l2 Window
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMSCombineTwo l1 l2 Window -> Maybe (TMSCombineTwo l1 l2 Window)
forall a. a -> Maybe a
Just (TMSCombineTwo l1 l2 Window
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> TMSCombineTwo l1 l2 Window
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window]
-> [Window]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 Bool
vsp 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) l1 Window
layout1 l2 Window
layout2
    | Just (IncMasterN Int
d) <- SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        let w :: [Window]
w = [Window]
w1[Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++[Window]
w2
            nmasterNew :: Int
nmasterNew = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (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)) ([Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
w)
            ([Window]
w1',[Window]
w2')  = Int -> [Window] -> ([Window], [Window])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
nmasterNew [Window]
w
        in Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TMSCombineTwo l1 l2 Window)
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> (TMSCombineTwo l1 l2 Window
    -> Maybe (TMSCombineTwo l1 l2 Window))
-> TMSCombineTwo l1 l2 Window
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMSCombineTwo l1 l2 Window -> Maybe (TMSCombineTwo l1 l2 Window)
forall a. a -> Maybe a
Just (TMSCombineTwo l1 l2 Window
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> TMSCombineTwo l1 l2 Window
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window]
-> [Window]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1' [Window]
w2' Bool
vsp Int
nmasterNew Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2
    | Just SwitchOrientation
SwitchOrientation <- SomeMessage -> Maybe SwitchOrientation
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            let m1 :: SomeMessage
m1 = if Bool
vsp then Orientation -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col else Orientation -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row
            in
            do Maybe (l1 Window)
mlayout1 <- l1 Window -> SomeMessage -> X (Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 SomeMessage
m1
               Maybe (l2 Window)
mlayout2 <- l2 Window -> SomeMessage -> X (Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 SomeMessage
m1
               Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TMSCombineTwo l1 l2 Window)
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ Maybe (l1 Window)
-> Maybe (l2 Window)
-> TMSCombineTwo l1 l2 Window
-> Bool
-> Maybe (TMSCombineTwo l1 l2 Window)
forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts  Maybe (l1 Window)
mlayout1 Maybe (l2 Window)
mlayout2 ([Window]
-> [Window]
-> [Window]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 (Bool -> Bool
not Bool
vsp) Int
nmaster Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2) Bool
True
    | Just SwapSubMaster
SwapSubMaster <- SomeMessage -> Maybe SwapSubMaster
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        -- first get the submaster window
        let subMaster :: Maybe Window
subMaster = if [Window] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Window]
w2 then Maybe Window
forall a. Maybe a
Nothing else Window -> Maybe Window
forall a. a -> Maybe a
Just (Window -> Maybe Window) -> Window -> Maybe Window
forall a b. (a -> b) -> a -> b
$ [Window] -> Window
forall a. [a] -> a
head [Window]
w2
        in case Maybe Window
subMaster of
            Just Window
mw -> do (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
-> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Window -> Stack Window -> Stack Window
forall a. Eq a => a -> Stack a -> Stack a
swapWindow Window
mw
                          Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TMSCombineTwo l1 l2 Window)
forall a. Maybe a
Nothing
            Maybe Window
Nothing -> Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TMSCombineTwo l1 l2 Window)
forall a. Maybe a
Nothing
    | Just FocusSubMaster
FocusSubMaster <- SomeMessage -> Maybe FocusSubMaster
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        -- first get the submaster window
        let subMaster :: Maybe Window
subMaster = if [Window] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Window]
w2 then Maybe Window
forall a. Maybe a
Nothing else Window -> Maybe Window
forall a. a -> Maybe a
Just (Window -> Maybe Window) -> Window -> Maybe Window
forall a b. (a -> b) -> a -> b
$ [Window] -> Window
forall a. [a] -> a
head [Window]
w2
        in case Maybe Window
subMaster of
            Just Window
mw -> do (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
-> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Window -> Stack Window -> Stack Window
forall a. Eq a => a -> Stack a -> Stack a
focusWindow Window
mw
                          Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TMSCombineTwo l1 l2 Window)
forall a. Maybe a
Nothing
            Maybe Window
Nothing -> Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TMSCombineTwo l1 l2 Window)
forall a. Maybe a
Nothing
    | Just ChangeFocus
NextFocus <- SomeMessage -> Maybe ChangeFocus
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        do
          -- All toggle message is passed to the sublayout with focused window
          Maybe (Stack Window)
mst <- (XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (WindowSet
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState -> WindowSet)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
          let nextw :: Maybe Window
nextw = [Window] -> Maybe (Stack Window) -> Bool -> Maybe Window
forall a. Eq a => [a] -> Maybe (Stack a) -> Bool -> Maybe a
adjFocus [Window]
f Maybe (Stack Window)
mst Bool
True
          case Maybe Window
nextw of Maybe Window
Nothing -> Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TMSCombineTwo l1 l2 Window)
forall a. Maybe a
Nothing
                        Just Window
w  -> do (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
-> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Window -> Stack Window -> Stack Window
forall a. Eq a => a -> Stack a -> Stack a
focusWindow Window
w
                                      Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TMSCombineTwo l1 l2 Window)
forall a. Maybe a
Nothing
    | Just ChangeFocus
PrevFocus <- SomeMessage -> Maybe ChangeFocus
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        do
          -- All toggle message is passed to the sublayout with focused window
          Maybe (Stack Window)
mst <- (XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (WindowSet
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState -> WindowSet)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
          let prevw :: Maybe Window
prevw = [Window] -> Maybe (Stack Window) -> Bool -> Maybe Window
forall a. Eq a => [a] -> Maybe (Stack a) -> Bool -> Maybe a
adjFocus [Window]
f Maybe (Stack Window)
mst Bool
False
          case Maybe Window
prevw of Maybe Window
Nothing -> Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TMSCombineTwo l1 l2 Window)
forall a. Maybe a
Nothing
                        Just Window
w  -> do (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
-> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Window -> Stack Window -> Stack Window
forall a. Eq a => a -> Stack a -> Stack a
focusWindow Window
w
                                      Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TMSCombineTwo l1 l2 Window)
forall a. Maybe a
Nothing
    -- messages that traverse recursively
    | Just Orientation
Row <- SomeMessage -> Maybe Orientation
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        do Maybe (l1 Window)
mlayout1 <- l1 Window -> SomeMessage -> X (Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 (Orientation -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col)
           Maybe (l2 Window)
mlayout2 <- l2 Window -> SomeMessage -> X (Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 (Orientation -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col)
           Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TMSCombineTwo l1 l2 Window)
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ Maybe (l1 Window)
-> Maybe (l2 Window)
-> TMSCombineTwo l1 l2 Window
-> Bool
-> Maybe (TMSCombineTwo l1 l2 Window)
forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 Window)
mlayout1 Maybe (l2 Window)
mlayout2 ([Window]
-> [Window]
-> [Window]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 Bool
False Int
nmaster Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2) Bool
True
    | Just Orientation
Col <- SomeMessage -> Maybe Orientation
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        do Maybe (l1 Window)
mlayout1 <- l1 Window -> SomeMessage -> X (Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 (Orientation -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row)
           Maybe (l2 Window)
mlayout2 <- l2 Window -> SomeMessage -> X (Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 (Orientation -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row)
           Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TMSCombineTwo l1 l2 Window)
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ Maybe (l1 Window)
-> Maybe (l2 Window)
-> TMSCombineTwo l1 l2 Window
-> Bool
-> Maybe (TMSCombineTwo l1 l2 Window)
forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 Window)
mlayout1 Maybe (l2 Window)
mlayout2 ([Window]
-> [Window]
-> [Window]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [Window]
f [Window]
w1 [Window]
w2 Bool
True Int
nmaster Rational
delta Rational
frac l1 Window
layout1 l2 Window
layout2) Bool
True
    | Just FocusedNextLayout
FocusedNextLayout <- SomeMessage -> Maybe FocusedNextLayout
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
       do
       -- All toggle message is passed to the sublayout with focused window
         Maybe (Stack Window)
mst <- (XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (WindowSet
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState -> WindowSet)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
         let focId :: Int
focId = Maybe (Stack Window) -> [Window] -> [Window] -> Int
forall a. Eq a => Maybe (Stack a) -> [a] -> [a] -> Int
findFocused Maybe (Stack Window)
mst [Window]
w1 [Window]
w2
             m1 :: SomeMessage
m1 = if Bool
vsp then Orientation -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row else Orientation -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col
         if Int
focId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
           then do
                 Maybe (l1 Window)
mlay1 <- l1 Window -> [SomeMessage] -> X (Maybe (l1 Window))
forall (l :: * -> *) a.
LayoutClass l a =>
l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages l1 Window
layout1 [ChangeLayout -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage ChangeLayout
NextLayout, SomeMessage
m1]
                 let mlay2 :: Maybe a
mlay2 = Maybe a
forall a. Maybe a
Nothing
                 Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TMSCombineTwo l1 l2 Window)
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ Maybe (l1 Window)
-> Maybe (l2 Window)
-> TMSCombineTwo l1 l2 Window
-> Bool
-> Maybe (TMSCombineTwo l1 l2 Window)
forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 Window)
mlay1 Maybe (l2 Window)
forall a. Maybe a
mlay2 TMSCombineTwo l1 l2 Window
i Bool
True
           else do
                 let mlay1 :: Maybe a
mlay1 = Maybe a
forall a. Maybe a
Nothing
                 Maybe (l2 Window)
mlay2 <- l2 Window -> [SomeMessage] -> X (Maybe (l2 Window))
forall (l :: * -> *) a.
LayoutClass l a =>
l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages l2 Window
layout2 [ChangeLayout -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage ChangeLayout
NextLayout, SomeMessage
m1]
                 Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TMSCombineTwo l1 l2 Window)
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ Maybe (l1 Window)
-> Maybe (l2 Window)
-> TMSCombineTwo l1 l2 Window
-> Bool
-> Maybe (TMSCombineTwo l1 l2 Window)
forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 Window)
forall a. Maybe a
mlay1 Maybe (l2 Window)
mlay2 TMSCombineTwo l1 l2 Window
i Bool
True
    | Bool
otherwise =
            do
              Maybe (l1 Window)
mlayout1 <- l1 Window -> SomeMessage -> X (Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 SomeMessage
m
              Maybe (l2 Window)
mlayout2 <- l2 Window -> SomeMessage -> X (Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 SomeMessage
m
              Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TMSCombineTwo l1 l2 Window)
 -> X (Maybe (TMSCombineTwo l1 l2 Window)))
-> Maybe (TMSCombineTwo l1 l2 Window)
-> X (Maybe (TMSCombineTwo l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ Maybe (l1 Window)
-> Maybe (l2 Window)
-> TMSCombineTwo l1 l2 Window
-> Bool
-> Maybe (TMSCombineTwo l1 l2 Window)
forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 Window)
mlayout1 Maybe (l2 Window)
mlayout2 TMSCombineTwo l1 l2 Window
i Bool
False



-- code from CombineTwo
-- given two sets of zs and xs takes the first z from zs that also belongs to xs
-- and turns xs into a stack with z being current element. Acts as
-- StackSet.differentiate if zs and xs don't intersect
differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate :: [q] -> [q] -> Maybe (Stack q)
differentiate (q
z:[q]
zs) [q]
xs | q
z q -> [q] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [q]
xs = Stack q -> Maybe (Stack q)
forall a. a -> Maybe a
Just (Stack q -> Maybe (Stack q)) -> Stack q -> Maybe (Stack q)
forall a b. (a -> b) -> a -> b
$ Stack :: forall a. a -> [a] -> [a] -> Stack a
Stack { focus :: q
focus=q
z
                                                     , up :: [q]
up = [q] -> [q]
forall a. [a] -> [a]
reverse ([q] -> [q]) -> [q] -> [q]
forall a b. (a -> b) -> a -> b
$ (q -> Bool) -> [q] -> [q]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (q -> q -> Bool
forall a. Eq a => a -> a -> Bool
/=q
z) [q]
xs
                                                     , down :: [q]
down = [q] -> [q]
forall a. [a] -> [a]
tail ([q] -> [q]) -> [q] -> [q]
forall a b. (a -> b) -> a -> b
$ (q -> Bool) -> [q] -> [q]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (q -> q -> Bool
forall a. Eq a => a -> a -> Bool
/=q
z) [q]
xs }
                        | Bool
otherwise = [q] -> [q] -> Maybe (Stack q)
forall q. Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate [q]
zs [q]
xs
differentiate [] [q]
xs = [q] -> Maybe (Stack q)
forall a. [a] -> Maybe (Stack a)
W.differentiate [q]
xs

-- | Swap a given window with the focused window.
swapWindow :: (Eq a) => a -> Stack a -> Stack a
swapWindow :: a -> Stack a -> Stack a
swapWindow a
w Stack a
s =
  let upLst :: [a]
upLst   = Stack a -> [a]
forall a. Stack a -> [a]
up Stack a
s
      foc :: a
foc     = Stack a -> a
forall a. Stack a -> a
focus Stack a
s
      downLst :: [a]
downLst = Stack a -> [a]
forall a. Stack a -> [a]
down Stack a
s
  in if a
w a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
downLst
     then let us :: [a]
us   = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
w) [a]
downLst
              a
d:[a]
ds = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
w) [a]
downLst
              us' :: [a]
us'  = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
us [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
upLst
          in  a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
foc [a]
us' [a]
ds
     else let ds :: [a]
ds   = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
w) [a]
upLst
              a
u:[a]
us = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
w) [a]
upLst
              ds' :: [a]
ds'  = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ds [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
u a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
downLst
          in  a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
foc [a]
us [a]
ds'


-- | Focus a given window.
focusWindow :: (Eq a) => a -> Stack a -> Stack a
focusWindow :: a -> Stack a -> Stack a
focusWindow a
w Stack a
s =
  if a
w a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Stack a -> [a]
forall a. Stack a -> [a]
up Stack a
s
  then a -> Stack a -> Stack a
forall a. Eq a => a -> Stack a -> Stack a
focusSubMasterU a
w Stack a
s
  else a -> Stack a -> Stack a
forall a. Eq a => a -> Stack a -> Stack a
focusSubMasterD a
w Stack a
s
  where
      focusSubMasterU :: a -> Stack a -> Stack a
focusSubMasterU a
win i :: Stack a
i@(Stack a
foc (a
l:[a]
ls) [a]
rs)
        | a
foc a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
win = Stack a
i
        | a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
win = Stack a
news
        | Bool
otherwise = a -> Stack a -> Stack a
focusSubMasterU a
win Stack a
news
        where
            news :: Stack a
news = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
l [a]
ls (a
foc a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs)
      focusSubMasterU a
_ (Stack a
foc [] [a]
rs) =
          a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
foc [] [a]
rs
      focusSubMasterD :: a -> Stack a -> Stack a
focusSubMasterD a
win i :: Stack a
i@(Stack a
foc [a]
ls (a
r:[a]
rs))
        | a
foc a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
win = Stack a
i
        | a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
win = Stack a
news
        | Bool
otherwise = a -> Stack a -> Stack a
focusSubMasterD a
win Stack a
news
        where
            news :: Stack a
news = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
r (a
foc a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ls) [a]
rs
      focusSubMasterD a
_ (Stack a
foc [a]
ls []) =
          a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
foc [a]
ls []

-- | Merge two Maybe sublayouts.
mergeSubLayouts
  :: Maybe (l1 a)           -- ^ Left  layout
  -> Maybe (l2 a)           -- ^ Right layout
  -> TMSCombineTwo l1 l2 a  -- ^ How to combine the layouts
  -> Bool                   -- ^ Return a 'Just' no matter what
  -> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts :: Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts Maybe (l1 a)
ml1 Maybe (l2 a)
ml2 (TMSCombineTwo [a]
f [a]
w1 [a]
w2 Bool
vsp Int
nmaster Rational
delta Rational
frac l1 a
l1 l2 a
l2) Bool
alwaysReturn
  | Bool
alwaysReturn = TMSCombineTwo l1 l2 a -> Maybe (TMSCombineTwo l1 l2 a)
forall a. a -> Maybe a
Just (TMSCombineTwo l1 l2 a -> Maybe (TMSCombineTwo l1 l2 a))
-> TMSCombineTwo l1 l2 a -> Maybe (TMSCombineTwo l1 l2 a)
forall a b. (a -> b) -> a -> b
$ [a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [a]
f [a]
w1 [a]
w2 Bool
vsp Int
nmaster Rational
delta Rational
frac (l1 a -> Maybe (l1 a) -> l1 a
forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 Maybe (l1 a)
ml1) (l2 a -> Maybe (l2 a) -> l2 a
forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 Maybe (l2 a)
ml2)
  | Maybe (l1 a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l1 a)
ml1 Bool -> Bool -> Bool
|| Maybe (l2 a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l2 a)
ml2 = TMSCombineTwo l1 l2 a -> Maybe (TMSCombineTwo l1 l2 a)
forall a. a -> Maybe a
Just (TMSCombineTwo l1 l2 a -> Maybe (TMSCombineTwo l1 l2 a))
-> TMSCombineTwo l1 l2 a -> Maybe (TMSCombineTwo l1 l2 a)
forall a b. (a -> b) -> a -> b
$ [a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
forall (l1 :: * -> *) (l2 :: * -> *) a.
[a]
-> [a]
-> [a]
-> Bool
-> Int
-> Rational
-> Rational
-> l1 a
-> l2 a
-> TMSCombineTwo l1 l2 a
TMSCombineTwo [a]
f [a]
w1 [a]
w2 Bool
vsp Int
nmaster Rational
delta Rational
frac (l1 a -> Maybe (l1 a) -> l1 a
forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 Maybe (l1 a)
ml1) (l2 a -> Maybe (l2 a) -> l2 a
forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 Maybe (l2 a)
ml2)
  | Bool
otherwise = Maybe (TMSCombineTwo l1 l2 a)
forall a. Maybe a
Nothing

findFocused :: (Eq a) => Maybe (Stack a) -> [a] -> [a] -> Int
findFocused :: Maybe (Stack a) -> [a] -> [a] -> Int
findFocused Maybe (Stack a)
mst [a]
w1 [a]
w2 =
        case Maybe (Stack a)
mst of
          Maybe (Stack a)
Nothing -> Int
1
          Just Stack a
st -> if a
foc a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
w1
                     then Int
1
                     else if a
foc a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
w2
                          then Int
2
                          else Int
1
                     where foc :: a
foc = Stack a -> a
forall a. Stack a -> a
W.focus Stack a
st

-- | Handle a list of messages one by one, then return the last refreshed layout.
handleMessages :: (LayoutClass l a) => l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages :: l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages l a
l = (Maybe (l a) -> SomeMessage -> X (Maybe (l a)))
-> Maybe (l a) -> [SomeMessage] -> X (Maybe (l a))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM  Maybe (l a) -> SomeMessage -> X (Maybe (l a))
forall (l :: * -> *) a.
LayoutClass l a =>
Maybe (l a) -> SomeMessage -> X (Maybe (l a))
handleMaybeMsg (l a -> Maybe (l a)
forall a. a -> Maybe a
Just l a
l)

handleMaybeMsg :: (LayoutClass l a) => Maybe (l a) -> SomeMessage -> X (Maybe (l a))
handleMaybeMsg :: Maybe (l a) -> SomeMessage -> X (Maybe (l a))
handleMaybeMsg Maybe (l a)
ml SomeMessage
m = case Maybe (l a)
ml of Just l a
l  -> do
                                              Maybe (l a)
res <- 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 (l a) -> X (Maybe (l a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (l a) -> X (Maybe (l a))) -> Maybe (l a) -> X (Maybe (l a))
forall a b. (a -> b) -> a -> b
$ Maybe (l a) -> Maybe (l a) -> Maybe (l a)
forall a. Maybe a -> Maybe a -> Maybe a
elseOr (l a -> Maybe (l a)
forall a. a -> Maybe a
Just l a
l) Maybe (l a)
res
                                 Maybe (l a)
Nothing -> Maybe (l a) -> X (Maybe (l a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (l a)
forall a. Maybe a
Nothing

-- function for splitting given stack for TallMastersCombo Layouts
splitStack :: (Eq a) => [a] -> Int -> Rational -> Maybe (Stack a) -> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])
splitStack :: [a]
-> Int
-> Rational
-> Maybe (Stack a)
-> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])
splitStack [a]
f Int
nmaster Rational
frac Maybe (Stack a)
s =
    let slst :: [a]
slst = Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
integrate' Maybe (Stack a)
s
        f' :: [a]
f' = case Maybe (Stack a)
s of (Just Stack a
s') -> Stack a -> a
forall a. Stack a -> a
focus Stack a
s'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
delete (Stack a -> a
forall a. Stack a -> a
focus Stack a
s') [a]
f
                       Maybe (Stack a)
Nothing   -> [a]
f
        snum :: Int
snum = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
slst
        ([a]
slst1, [a]
slst2) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
nmaster [a]
slst
        s0 :: Maybe (Stack a)
s0 = [a] -> [a] -> Maybe (Stack a)
forall q. Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate [a]
f' [a]
slst
        s1' :: Maybe (Stack a)
s1' = [a] -> [a] -> Maybe (Stack a)
forall q. Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate [a]
f' [a]
slst1
        s2' :: Maybe (Stack a)
s2' = [a] -> [a] -> Maybe (Stack a)
forall q. Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate [a]
f' [a]
slst2
        (Maybe (Stack a)
s1,Maybe (Stack a)
s2,Rational
frac') | Int
nmaster Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = (Maybe (Stack a)
forall a. Maybe a
Nothing,Maybe (Stack a)
s0,Rational
0)
                      | Int
nmaster Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
snum = (Maybe (Stack a)
s0,Maybe (Stack a)
forall a. Maybe a
Nothing,Rational
1)
                      | Bool
otherwise       = (Maybe (Stack a)
s1',Maybe (Stack a)
s2',Rational
frac)
    in (Maybe (Stack a)
s1,Maybe (Stack a)
s2,Rational
frac',[a]
slst1,[a]
slst2)

-- find adjacent window of the current focus window
type Next = Bool
adjFocus :: (Eq a) => [a] -> Maybe (Stack a) -> Next -> Maybe a
adjFocus :: [a] -> Maybe (Stack a) -> Bool -> Maybe a
adjFocus [a]
ws Maybe (Stack a)
ms Bool
next =
  case Maybe (Stack a)
ms of Maybe (Stack a)
Nothing -> Maybe a
forall a. Maybe a
Nothing
             Just Stack a
s  -> let searchLst :: [a]
searchLst = if Bool
next
                                        then Stack a -> [a]
forall a. Stack a -> [a]
down Stack a
s [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse (Stack a -> [a]
forall a. Stack a -> [a]
up Stack a
s)
                                        else Stack a -> [a]
forall a. Stack a -> [a]
up Stack a
s [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse (Stack a -> [a]
forall a. Stack a -> [a]
down Stack a
s)
                        in  (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ws) [a]
searchLst

-- right biased maybe merge
elseOr :: Maybe a -> Maybe a -> Maybe a
elseOr :: Maybe a -> Maybe a -> Maybe a
elseOr Maybe a
x Maybe a
y = case Maybe a
y of
              Just a
_  -> Maybe a
y
              Maybe a
Nothing -> Maybe a
x

----------------- All the rest are for changing focus functionality -------------------

-- | A wrapper for Choose, for monitoring the current active layout. This is because
-- the original Choose layout does not export the data constructor.
data LR = L | R deriving (Int -> LR -> ShowS
[LR] -> ShowS
LR -> String
(Int -> LR -> ShowS)
-> (LR -> String) -> ([LR] -> ShowS) -> Show LR
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LR] -> ShowS
$cshowList :: [LR] -> ShowS
show :: LR -> String
$cshow :: LR -> String
showsPrec :: Int -> LR -> ShowS
$cshowsPrec :: Int -> LR -> ShowS
Show, ReadPrec [LR]
ReadPrec LR
Int -> ReadS LR
ReadS [LR]
(Int -> ReadS LR)
-> ReadS [LR] -> ReadPrec LR -> ReadPrec [LR] -> Read LR
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LR]
$creadListPrec :: ReadPrec [LR]
readPrec :: ReadPrec LR
$creadPrec :: ReadPrec LR
readList :: ReadS [LR]
$creadList :: ReadS [LR]
readsPrec :: Int -> ReadS LR
$creadsPrec :: Int -> ReadS LR
Read, LR -> LR -> Bool
(LR -> LR -> Bool) -> (LR -> LR -> Bool) -> Eq LR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LR -> LR -> Bool
$c/= :: LR -> LR -> Bool
== :: LR -> LR -> Bool
$c== :: LR -> LR -> Bool
Eq)
data ChooseWrapper l r a = ChooseWrapper LR (l a) (r a) (Choose l r a) deriving (Int -> ChooseWrapper l r a -> ShowS
[ChooseWrapper l r a] -> ShowS
ChooseWrapper l r a -> String
(Int -> ChooseWrapper l r a -> ShowS)
-> (ChooseWrapper l r a -> String)
-> ([ChooseWrapper l r a] -> ShowS)
-> Show (ChooseWrapper 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 -> ChooseWrapper l r a -> ShowS
forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
[ChooseWrapper l r a] -> ShowS
forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
ChooseWrapper l r a -> String
showList :: [ChooseWrapper l r a] -> ShowS
$cshowList :: forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
[ChooseWrapper l r a] -> ShowS
show :: ChooseWrapper l r a -> String
$cshow :: forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
ChooseWrapper l r a -> String
showsPrec :: Int -> ChooseWrapper l r a -> ShowS
$cshowsPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Show (l a), Show (r a)) =>
Int -> ChooseWrapper l r a -> ShowS
Show, ReadPrec [ChooseWrapper l r a]
ReadPrec (ChooseWrapper l r a)
Int -> ReadS (ChooseWrapper l r a)
ReadS [ChooseWrapper l r a]
(Int -> ReadS (ChooseWrapper l r a))
-> ReadS [ChooseWrapper l r a]
-> ReadPrec (ChooseWrapper l r a)
-> ReadPrec [ChooseWrapper l r a]
-> Read (ChooseWrapper 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 [ChooseWrapper l r a]
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec (ChooseWrapper l r a)
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
Int -> ReadS (ChooseWrapper l r a)
forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadS [ChooseWrapper l r a]
readListPrec :: ReadPrec [ChooseWrapper l r a]
$creadListPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec [ChooseWrapper l r a]
readPrec :: ReadPrec (ChooseWrapper l r a)
$creadPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadPrec (ChooseWrapper l r a)
readList :: ReadS [ChooseWrapper l r a]
$creadList :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
ReadS [ChooseWrapper l r a]
readsPrec :: Int -> ReadS (ChooseWrapper l r a)
$creadsPrec :: forall (l :: * -> *) (r :: * -> *) a.
(Read (l a), Read (r a)) =>
Int -> ReadS (ChooseWrapper l r a)
Read)

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

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)

data End = End | NoEnd

instance (GetFocused l a, GetFocused r a) => LayoutClass (ChooseWrapper l r) a where
  description :: ChooseWrapper l r a -> String
description (ChooseWrapper LR
_ l a
_ r a
_ Choose l r a
lr) = Choose l r a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description Choose l r a
lr

  runLayout :: Workspace String (ChooseWrapper l r a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (ChooseWrapper l r a))
runLayout (Workspace String
wid (ChooseWrapper LR
d l a
l r a
r Choose l r a
lr) Maybe (Stack a)
s) Rectangle
rec =
    do
      let (l a
l', r a
r') = case LR
d of LR
L -> (l a -> Maybe (Stack a) -> l a
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused l a
l Maybe (Stack a)
s, r a
r)
                               LR
R -> (l a
l, r a -> Maybe (Stack a) -> r a
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused r a
r Maybe (Stack a)
s)
      ([(a, Rectangle)]
ws, Maybe (Choose l r a)
ml0) <- Workspace String (Choose l r a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (Choose l r a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> Choose l r a
-> Maybe (Stack a)
-> Workspace String (Choose l r a) a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
wid Choose l r a
lr Maybe (Stack a)
s) Rectangle
rec
      let l1 :: Maybe (ChooseWrapper l r a)
l1 = case Maybe (Choose l r a)
ml0 of Just Choose l r a
l0 -> ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a. a -> Maybe a
Just (ChooseWrapper l r a -> Maybe (ChooseWrapper l r a))
-> ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a b. (a -> b) -> a -> b
$ LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d l a
l' r a
r' Choose l r a
l0
                           Maybe (Choose l r a)
Nothing -> Maybe (ChooseWrapper l r a)
forall a. Maybe a
Nothing
      ([(a, Rectangle)], Maybe (ChooseWrapper l r a))
-> X ([(a, Rectangle)], Maybe (ChooseWrapper l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
ws,Maybe (ChooseWrapper l r a)
l1)

  handleMessage :: ChooseWrapper l r a
-> SomeMessage -> X (Maybe (ChooseWrapper l r a))
handleMessage c :: ChooseWrapper l r a
c@(ChooseWrapper LR
d l a
l r a
r 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 -> SomeMessage -> X (Maybe (Choose l r a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Choose l r a
lr SomeMessage
m
        Maybe (ChooseWrapper l r a)
mlrf <- ChooseWrapper l r a
-> NextNoWrap -> X (Maybe (ChooseWrapper l r a))
forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle ChooseWrapper l r a
c NextNoWrap
NextNoWrap
        Maybe (ChooseWrapper l r a)
fstf <- ChooseWrapper l r a
-> ChangeLayout -> X (Maybe (ChooseWrapper l r a))
forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle ChooseWrapper l r a
c ChangeLayout
FirstLayout
        let mlf :: Maybe (ChooseWrapper l r a)
mlf = Maybe (ChooseWrapper l r a)
-> Maybe (ChooseWrapper l r a) -> Maybe (ChooseWrapper l r a)
forall a. Maybe a -> Maybe a -> Maybe a
elseOr Maybe (ChooseWrapper l r a)
fstf Maybe (ChooseWrapper l r a)
mlrf
            (LR
d',l a
l',r a
r') = case Maybe (ChooseWrapper l r a)
mlf of Just (ChooseWrapper LR
d0 l a
l0 r a
r0 Choose l r a
_) -> (LR
d0,l a
l0,r a
r0)
                                     Maybe (ChooseWrapper l r a)
Nothing                     -> (LR
d,l a
l,r a
r)
        case Maybe (Choose l r a)
mlr' of Just Choose l r a
lrt -> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a)))
-> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall a b. (a -> b) -> a -> b
$ ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a. a -> Maybe a
Just (ChooseWrapper l r a -> Maybe (ChooseWrapper l r a))
-> ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a b. (a -> b) -> a -> b
$ LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d' l a
l' r a
r' Choose l r a
lrt
                     Maybe (Choose l r a)
Nothing  -> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ChooseWrapper l r a)
forall a. Maybe a
Nothing
    | Just NextNoWrap
NextNoWrap <- SomeMessage -> Maybe NextNoWrap
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
        Maybe (Choose l r a)
mlr' <- Choose l r a -> SomeMessage -> X (Maybe (Choose l r a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Choose l r a
lr SomeMessage
m
        (LR
d',l a
l',r a
r', End
end) <-
              case LR
d of
                LR
L -> 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
l0 -> (LR, l a, r a, End) -> X (LR, l a, r a, End)
forall (m :: * -> *) a. Monad m => a -> m a
return (LR
L, l a
l0, r a
r, End
NoEnd)
                           Maybe (l a)
Nothing -> do
                                  Maybe (r a)
mr <- 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
                                  case Maybe (r a)
mr of
                                    Just r a
r0 -> (LR, l a, r a, End) -> X (LR, l a, r a, End)
forall (m :: * -> *) a. Monad m => a -> m a
return (LR
R, l a
l, r a
r0, End
NoEnd)
                                    Maybe (r a)
Nothing -> (LR, l a, r a, End) -> X (LR, l a, r a, End)
forall (m :: * -> *) a. Monad m => a -> m a
return (LR
R, l a
l, r a
r, End
NoEnd)
                LR
R -> do
                       Maybe (r a)
mr <- 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
                       case Maybe (r a)
mr of
                         Just r a
r0 -> (LR, l a, r a, End) -> X (LR, l a, r a, End)
forall (m :: * -> *) a. Monad m => a -> m a
return (LR
R, l a
l, r a
r0, End
NoEnd)
                         Maybe (r a)
Nothing -> (LR, l a, r a, End) -> X (LR, l a, r a, End)
forall (m :: * -> *) a. Monad m => a -> m a
return (LR
d, l a
l, r a
r, End
End)
        case Maybe (Choose l r a)
mlr' of Just Choose l r a
lrt -> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a)))
-> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall a b. (a -> b) -> a -> b
$ ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a. a -> Maybe a
Just (ChooseWrapper l r a -> Maybe (ChooseWrapper l r a))
-> ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a b. (a -> b) -> a -> b
$ LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d' l a
l' r a
r' Choose l r a
lrt
                     Maybe (Choose l r a)
Nothing  ->
                        case End
end of End
NoEnd -> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a)))
-> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall a b. (a -> b) -> a -> b
$ ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a. a -> Maybe a
Just (ChooseWrapper l r a -> Maybe (ChooseWrapper l r a))
-> ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a b. (a -> b) -> a -> b
$ LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d' l a
l' r a
r' Choose l r a
lr
                                    End
End   -> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ChooseWrapper l r a)
forall a. Maybe a
Nothing
    | Just ChangeLayout
FirstLayout <- SomeMessage -> Maybe ChangeLayout
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
        Maybe (Choose l r a)
mlr' <- Choose l r a -> SomeMessage -> X (Maybe (Choose l r a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Choose l r a
lr SomeMessage
m
        (LR
d',l a
l',r a
r') <- do
                        Maybe (l a)
ml <- 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
                        case Maybe (l a)
ml of
                          Just l a
l0 -> (LR, l a, r a) -> X (LR, l a, r a)
forall (m :: * -> *) a. Monad m => a -> m a
return (LR
L,l a
l0,r a
r)
                          Maybe (l a)
Nothing -> (LR, l a, r a) -> X (LR, l a, r a)
forall (m :: * -> *) a. Monad m => a -> m a
return (LR
L,l a
l,r a
r)
        case Maybe (Choose l r a)
mlr' of Just Choose l r a
lrt -> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a)))
-> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall a b. (a -> b) -> a -> b
$ ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a. a -> Maybe a
Just (ChooseWrapper l r a -> Maybe (ChooseWrapper l r a))
-> ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a b. (a -> b) -> a -> b
$ LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d' l a
l' r a
r' Choose l r a
lrt
                     Maybe (Choose l r a)
Nothing  -> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a)))
-> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall a b. (a -> b) -> a -> b
$ ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a. a -> Maybe a
Just (ChooseWrapper l r a -> Maybe (ChooseWrapper l r a))
-> ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a b. (a -> b) -> a -> b
$ LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d' l a
l' r a
r' Choose l r a
lr
    | Bool
otherwise = do
        Maybe (Choose l r a)
mlr' <- Choose l r a -> SomeMessage -> X (Maybe (Choose l r a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Choose l r a
lr SomeMessage
m
        case Maybe (Choose l r a)
mlr' of Just Choose l r a
lrt -> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a)))
-> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall a b. (a -> b) -> a -> b
$ ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a. a -> Maybe a
Just (ChooseWrapper l r a -> Maybe (ChooseWrapper l r a))
-> ChooseWrapper l r a -> Maybe (ChooseWrapper l r a)
forall a b. (a -> b) -> a -> b
$ LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d l a
l r a
r Choose l r a
lrt
                     Maybe (Choose l r a)
Nothing  -> Maybe (ChooseWrapper l r a) -> X (Maybe (ChooseWrapper l r a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ChooseWrapper l r a)
forall a. Maybe a
Nothing

-- | This is same as the Choose combination operator.
(|||) :: l a -> r a -> ChooseWrapper l r a
||| :: l a -> r a -> ChooseWrapper l r a
(|||) l a
l r a
r = LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
L l a
l r a
r (l a
l l a -> r a -> Choose l r a
forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
LL.||| r a
r)

-- a subclass of layout, which contain extra method to return focused window in sub-layouts
class (LayoutClass l a) => GetFocused l a where
  getFocused :: l a -> Maybe (Stack a) -> ([a], String)
  getFocused l a
_ Maybe (Stack a)
ms =
    case Maybe (Stack a)
ms of (Just Stack a
s) -> ([Stack a -> a
forall a. Stack a -> a
focus Stack a
s], String
"Base")
               Maybe (Stack a)
Nothing  -> ([], String
"Base")
  savFocused :: l a -> Maybe (Stack a) -> l a
  savFocused l a
l Maybe (Stack a)
_ = l a
l

instance (GetFocused l Window, GetFocused r Window) => GetFocused (TMSCombineTwo l r) Window where
  getFocused :: TMSCombineTwo l r Window
-> Maybe (Stack Window) -> ([Window], String)
getFocused (TMSCombineTwo [Window]
f [Window]
_ [Window]
_ Bool
_ Int
nmaster Rational
_ Rational
frac l Window
lay1 r Window
lay2) Maybe (Stack Window)
s =
    let (Maybe (Stack Window)
s1,Maybe (Stack Window)
s2,Rational
_,[Window]
_,[Window]
_) = [Window]
-> Int
-> Rational
-> Maybe (Stack Window)
-> (Maybe (Stack Window), Maybe (Stack Window), Rational, [Window],
    [Window])
forall a.
Eq a =>
[a]
-> Int
-> Rational
-> Maybe (Stack a)
-> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])
splitStack [Window]
f Int
nmaster Rational
frac Maybe (Stack Window)
s
        ([Window]
f1, String
str1) = l Window -> Maybe (Stack Window) -> ([Window], String)
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused l Window
lay1 Maybe (Stack Window)
s1
        ([Window]
f2, String
str2) = r Window -> Maybe (Stack Window) -> ([Window], String)
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused r Window
lay2 Maybe (Stack Window)
s2
    in  ([Window]
f1 [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
f2, String
"TMS: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Window] -> String
forall a. Show a => a -> String
show [Window]
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str2)
  savFocused :: TMSCombineTwo l r Window
-> Maybe (Stack Window) -> TMSCombineTwo l r Window
savFocused i :: TMSCombineTwo l r Window
i@(TMSCombineTwo [Window]
f [Window]
_ [Window]
_ Bool
_ Int
nmaster Rational
_ Rational
frac l Window
lay1 r Window
lay2) Maybe (Stack Window)
s =
    let (Maybe (Stack Window)
s1,Maybe (Stack Window)
s2,Rational
_,[Window]
_,[Window]
_) = [Window]
-> Int
-> Rational
-> Maybe (Stack Window)
-> (Maybe (Stack Window), Maybe (Stack Window), Rational, [Window],
    [Window])
forall a.
Eq a =>
[a]
-> Int
-> Rational
-> Maybe (Stack a)
-> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])
splitStack [Window]
f Int
nmaster Rational
frac Maybe (Stack Window)
s
        ([Window]
f', String
_) = TMSCombineTwo l r Window
-> Maybe (Stack Window) -> ([Window], String)
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused TMSCombineTwo l r Window
i Maybe (Stack Window)
s
        lay1' :: l Window
lay1' = l Window -> Maybe (Stack Window) -> l Window
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused l Window
lay1 Maybe (Stack Window)
s1
        lay2' :: r Window
lay2' = r Window -> Maybe (Stack Window) -> r Window
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused r Window
lay2 Maybe (Stack Window)
s2
    in TMSCombineTwo l r Window
i {focusLst :: [Window]
focusLst = [Window]
f', layoutFst :: l Window
layoutFst=l Window
lay1', layoutSnd :: r Window
layoutSnd=r Window
lay2'}

instance (GetFocused l a, GetFocused r a) => GetFocused (ChooseWrapper l r) a where
  getFocused :: ChooseWrapper l r a -> Maybe (Stack a) -> ([a], String)
getFocused (ChooseWrapper LR
d l a
l r a
r Choose l r a
_) Maybe (Stack a)
s =
    case LR
d of LR
L -> l a -> Maybe (Stack a) -> ([a], String)
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused l a
l Maybe (Stack a)
s
              LR
R -> r a -> Maybe (Stack a) -> ([a], String)
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused r a
r Maybe (Stack a)
s
  savFocused :: ChooseWrapper l r a -> Maybe (Stack a) -> ChooseWrapper l r a
savFocused (ChooseWrapper LR
d l a
l r a
r Choose l r a
lr) Maybe (Stack a)
s =
    let (l a
l', r a
r') =
                  case LR
d of LR
L -> (l a -> Maybe (Stack a) -> l a
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused l a
l Maybe (Stack a)
s, r a
r)
                            LR
R -> (l a
l, r a -> Maybe (Stack a) -> r a
forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused r a
r Maybe (Stack a)
s)
    in LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
forall (l :: * -> *) (r :: * -> *) a.
LR -> l a -> r a -> Choose l r a -> ChooseWrapper l r a
ChooseWrapper LR
d l a
l' r a
r' Choose l r a
lr

instance (Typeable a) => GetFocused Simplest a
instance (Typeable a) => GetFocused RowsOrColumns a
instance (Typeable a) => GetFocused Full a
instance (Typeable a) => GetFocused Tall a
instance (Typeable l, Typeable a, Typeable m, LayoutModifier m a, LayoutClass l a) => GetFocused (ModifiedLayout m l) a