-- {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}

---------------------------------------------------------------------------
-- |
-- 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 qualified XMonad.Layout as LL
import XMonad.Layout.Decoration
import XMonad.Layout.Simplest (Simplest (..))
import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust, listToMaybe)
import XMonad.StackSet (Stack (..), Workspace (..), integrate')
import qualified XMonad.StackSet as W
import XMonad.Util.Stack (zipperFocusedAtFirstOf)

---------------------------------------------------------------------------------
-- $usage
-- You can use this module with the following in your @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 { forall a. RowsOrColumns a -> Bool
rowMode :: Bool -- ^ arrange windows in rows or columns
                                        } deriving (Int -> RowsOrColumns a -> ShowS
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)
ReadS [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 = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rs
    where ws :: [a]
ws = forall a. Stack a -> [a]
W.integrate Stack a
s
          len :: Int
len = 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 <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bool -> RowsOrColumns a
RowsOrColumns Bool
True
    | Just Orientation
Col <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bool -> RowsOrColumns a
RowsOrColumns Bool
False
    | Bool
otherwise = forall a. Maybe a
Nothing


data TMSCombineTwo l1 l2 a =
  TMSCombineTwo { forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> [a]
focusLst :: [a]
                , forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> [a]
ws1 :: [a]
                , forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> [a]
ws2 :: [a]
                , forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> Bool
rowMod :: Bool  -- ^ merge two layouts in a column or a row
                , forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> Int
nMaster :: !Int     -- ^ number of windows in the master pane
                , forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> Rational
rationInc :: !Rational -- ^ percent of screen to increment by when resizing panes
                , forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> Rational
tallComboRatio :: !Rational -- ^ default proportion of screen occupied by master pane
                , forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> l1 a
layoutFst :: l1 a  -- ^ layout for the master pane
                , forall (l1 :: * -> *) (l2 :: * -> *) a.
TMSCombineTwo l1 l2 a -> l2 a
layoutSnd :: l2 a  -- ^ layout for the second pane
                }
        deriving (Int -> TMSCombineTwo l1 l2 a -> ShowS
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)
ReadS [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 :: forall (l1 :: * -> *) (l2 :: * -> *).
(LayoutClass l1 Window, LayoutClass l2 Window) =>
l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window
tmsCombineTwoDefault = 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
3forall a. Fractional a => a -> a -> a
/Rational
100) (Rational
1forall 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 :: forall (l1 :: * -> *) (l2 :: * -> *).
(LayoutClass l1 Window, LayoutClass l2 Window) =>
Bool
-> Int
-> Rational
-> Rational
-> l1 Window
-> l2 Window
-> TMSCombineTwo l1 l2 Window
tmsCombineTwo = 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]
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
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]
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
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]
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
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]
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
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]
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
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]
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
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) = 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 forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
frac' Rectangle
r
                     else forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy Rational
frac' Rectangle
r
      in
      do
         ([(Window, Rectangle)]
ws , Maybe (l1 Window)
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
Workspace String
wid l1 Window
layout1 Maybe (Stack Window)
s1) Rectangle
r1
         ([(Window, Rectangle)]
ws', Maybe (l2 Window)
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
Workspace String
wid l2 Window
layout2 Maybe (Stack Window)
s2) Rectangle
r2
         let newlayout1 :: l1 Window
newlayout1 = forall a. a -> Maybe a -> a
fromMaybe l1 Window
layout1 Maybe (l1 Window)
ml
             newlayout2 :: l2 Window
newlayout2 = forall a. a -> Maybe a -> a
fromMaybe l2 Window
layout2 Maybe (l2 Window)
ml'
             ([Window]
f1, 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
_) = 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 forall a. [a] -> [a] -> [a]
++ [Window]
f2
         forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
wsforall a. [a] -> [a] -> [a]
++[(Window, Rectangle)]
ws', forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 (forall a. Ord a => a -> a -> a
max Rational
0 forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
-Rational
delta) l1 Window
layout1 l2 Window
layout2
    | Just Resize
Expand <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 (forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
+Rational
delta) l1 Window
layout1 l2 Window
layout2
    | Just (IncMasterN Int
d) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        let w :: [Window]
w = [Window]
w1forall a. [a] -> [a] -> [a]
++[Window]
w2
            nmasterNew :: Int
nmasterNew = forall a. Ord a => a -> a -> a
min (forall a. Ord a => a -> a -> a
max Int
0 (Int
nmasterforall a. Num a => a -> a -> a
+Int
d)) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
w)
            ([Window]
w1',[Window]
w2')  = forall a. Int -> [a] -> ([a], [a])
splitAt Int
nmasterNew [Window]
w
        in forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            let m1 :: SomeMessage
m1 = if Bool
vsp then forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col else forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row
            in
            do Maybe (l1 Window)
mlayout1 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 SomeMessage
m1
               Maybe (l2 Window)
mlayout2 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 SomeMessage
m1
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 (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 <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        -- first get the submaster window
        let subMaster :: Maybe Window
subMaster = forall a. [a] -> Maybe a
listToMaybe [Window]
w2
        in case Maybe Window
subMaster of
            Just Window
mw -> do (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> Stack a -> Stack a
swapWindow Window
mw
                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            Maybe Window
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    | Just FocusSubMaster
FocusSubMaster <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        -- first get the submaster window
        let subMaster :: Maybe Window
subMaster = forall a. [a] -> Maybe a
listToMaybe [Window]
w2
        in case Maybe Window
subMaster of
            Just Window
mw -> do (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> Stack a -> Stack a
focusWindow Window
mw
                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            Maybe Window
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    | Just ChangeFocus
NextFocus <- 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
          let nextw :: Maybe Window
nextw = 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                        Just Window
w  -> do (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> Stack a -> Stack a
focusWindow Window
w
                                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    | Just ChangeFocus
PrevFocus <- 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
          let prevw :: Maybe Window
prevw = 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                        Just Window
w  -> do (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> Stack a -> Stack a
focusWindow Window
w
                                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    -- messages that traverse recursively
    | Just Orientation
Row <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        do Maybe (l1 Window)
mlayout1 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 (forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col)
           Maybe (l2 Window)
mlayout2 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 (forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col)
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 (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 <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
        do Maybe (l1 Window)
mlayout1 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 (forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row)
           Maybe (l2 Window)
mlayout2 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 (forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row)
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 (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 <- 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
         let focId :: Int
focId = 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 forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Row else forall a. Message a => a -> SomeMessage
SomeMessage Orientation
Col
         if Int
focId forall a. Eq a => a -> a -> Bool
== Int
1
           then do
                 Maybe (l1 Window)
mlay1 <- forall (l :: * -> *) a.
LayoutClass l a =>
l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages l1 Window
layout1 [forall a. Message a => a -> SomeMessage
SomeMessage ChangeLayout
NextLayout, SomeMessage
m1]
                 let mlay2 :: Maybe a
mlay2 = forall a. Maybe a
Nothing
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall a. Maybe a
mlay2 TMSCombineTwo l1 l2 Window
i Bool
True
           else do
                 let mlay1 :: Maybe a
mlay1 = forall a. Maybe a
Nothing
                 Maybe (l2 Window)
mlay2 <- forall (l :: * -> *) a.
LayoutClass l a =>
l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages l2 Window
layout2 [forall a. Message a => a -> SomeMessage
SomeMessage ChangeLayout
NextLayout, SomeMessage
m1]
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) a (l2 :: * -> *).
Maybe (l1 a)
-> Maybe (l2 a)
-> TMSCombineTwo l1 l2 a
-> Bool
-> Maybe (TMSCombineTwo l1 l2 a)
mergeSubLayouts forall a. Maybe a
mlay1 Maybe (l2 Window)
mlay2 TMSCombineTwo l1 l2 Window
i Bool
True
    | Bool
otherwise =
            do
              Maybe (l1 Window)
mlayout1 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
layout1 SomeMessage
m
              Maybe (l2 Window)
mlayout2 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
layout2 SomeMessage
m
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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

-- | Swap a given window with the focused window.
swapWindow :: (Eq a) => a -> Stack a -> Stack a
swapWindow :: forall a. Eq a => a -> Stack a -> Stack a
swapWindow a
w (Stack a
foc [a]
upLst [a]
downLst)
    | ([a]
us, a
d:[a]
ds) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== a
w) [a]
downLst = forall a. a -> [a] -> [a] -> Stack a
Stack a
foc (forall a. [a] -> [a]
reverse [a]
us forall a. [a] -> [a] -> [a]
++ a
d forall a. a -> [a] -> [a]
: [a]
upLst) [a]
ds
    | ([a]
ds, a
u:[a]
us) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== a
w)   [a]
upLst = forall a. a -> [a] -> [a] -> Stack a
Stack a
foc [a]
us (forall a. [a] -> [a]
reverse [a]
ds forall a. [a] -> [a] -> [a]
++ a
u forall a. a -> [a] -> [a]
: [a]
downLst)
    | Bool
otherwise = forall a. a -> [a] -> [a] -> Stack a
Stack a
foc [a]
upLst [a]
downLst


-- | Focus a given window.
focusWindow :: (Eq a) => a -> Stack a -> Stack a
focusWindow :: forall a. Eq a => a -> Stack a -> Stack a
focusWindow a
w Stack a
s =
  if a
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Stack a -> [a]
up Stack a
s
  then forall a. Eq a => a -> Stack a -> Stack a
focusSubMasterU a
w Stack a
s
  else forall a. Eq a => a -> Stack a -> Stack a
focusSubMasterD a
w Stack a
s
  where
      focusSubMasterU :: t -> Stack t -> Stack t
focusSubMasterU t
win i :: Stack t
i@(Stack t
foc (t
l:[t]
ls) [t]
rs)
        | t
foc forall a. Eq a => a -> a -> Bool
== t
win = Stack t
i
        | t
l forall a. Eq a => a -> a -> Bool
== t
win = Stack t
news
        | Bool
otherwise = t -> Stack t -> Stack t
focusSubMasterU t
win Stack t
news
        where
            news :: Stack t
news = forall a. a -> [a] -> [a] -> Stack a
Stack t
l [t]
ls (t
foc forall a. a -> [a] -> [a]
: [t]
rs)
      focusSubMasterU t
_ (Stack t
foc [] [t]
rs) =
          forall a. a -> [a] -> [a] -> Stack a
Stack t
foc [] [t]
rs
      focusSubMasterD :: t -> Stack t -> Stack t
focusSubMasterD t
win i :: Stack t
i@(Stack t
foc [t]
ls (t
r:[t]
rs))
        | t
foc forall a. Eq a => a -> a -> Bool
== t
win = Stack t
i
        | t
r forall a. Eq a => a -> a -> Bool
== t
win = Stack t
news
        | Bool
otherwise = t -> Stack t -> Stack t
focusSubMasterD t
win Stack t
news
        where
            news :: Stack t
news = forall a. a -> [a] -> [a] -> Stack a
Stack t
r (t
foc forall a. a -> [a] -> [a]
: [t]
ls) [t]
rs
      focusSubMasterD t
_ (Stack t
foc [t]
ls []) =
          forall a. a -> [a] -> [a] -> Stack a
Stack t
foc [t]
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 :: forall (l1 :: * -> *) a (l2 :: * -> *).
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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 (forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 Maybe (l1 a)
ml1) (forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 Maybe (l2 a)
ml2)
  | forall a. Maybe a -> Bool
isJust Maybe (l1 a)
ml1 Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (l2 a)
ml2 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 (forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 Maybe (l1 a)
ml1) (forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 Maybe (l2 a)
ml2)
  | Bool
otherwise = forall a. Maybe a
Nothing

findFocused :: (Eq a) => Maybe (Stack a) -> [a] -> [a] -> Int
findFocused :: forall a. Eq a => 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
w1
                     then Int
1
                     else if a
foc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
w2
                          then Int
2
                          else Int
1
                     where foc :: a
foc = 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 :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> [SomeMessage] -> X (Maybe (l a))
handleMessages l a
l = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM  forall (l :: * -> *) a.
LayoutClass l a =>
Maybe (l a) -> SomeMessage -> X (Maybe (l a))
handleMaybeMsg (forall a. a -> Maybe a
Just l a
l)

handleMaybeMsg :: (LayoutClass l a) => Maybe (l a) -> SomeMessage -> X (Maybe (l a))
handleMaybeMsg :: forall (l :: * -> *) a.
LayoutClass l a =>
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 <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
m
                                              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Maybe a -> Maybe a
elseOr (forall a. a -> Maybe a
Just l a
l) Maybe (l a)
res
                                 Maybe (l a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall a.
Eq a =>
[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 = forall a. Maybe (Stack a) -> [a]
integrate' Maybe (Stack a)
s
        f' :: [a]
f' = case Maybe (Stack a)
s of (Just Stack a
s') -> forall a. Stack a -> a
focus Stack a
s'forall a. a -> [a] -> [a]
:forall a. Eq a => a -> [a] -> [a]
delete (forall a. Stack a -> a
focus Stack a
s') [a]
f
                       Maybe (Stack a)
Nothing   -> [a]
f
        snum :: Int
snum = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
slst
        ([a]
slst1, [a]
slst2) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
nmaster [a]
slst
        s0 :: Maybe (Stack a)
s0 = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [a]
f' [a]
slst
        s1' :: Maybe (Stack a)
s1' = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [a]
f' [a]
slst1
        s2' :: Maybe (Stack a)
s2' = forall q. Eq q => [q] -> [q] -> Zipper q
zipperFocusedAtFirstOf [a]
f' [a]
slst2
        (Maybe (Stack a)
s1,Maybe (Stack a)
s2,Rational
frac') | Int
nmaster forall a. Eq a => a -> a -> Bool
== Int
0    = (forall a. Maybe a
Nothing,Maybe (Stack a)
s0,Rational
0)
                      | Int
nmaster forall a. Ord a => a -> a -> Bool
>= Int
snum = (Maybe (Stack a)
s0,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 :: forall a. Eq a => [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 -> forall a. Maybe a
Nothing
             Just Stack a
s  -> let searchLst :: [a]
searchLst = if Bool
next
                                        then forall a. Stack a -> [a]
down Stack a
s forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse (forall a. Stack a -> [a]
up Stack a
s)
                                        else forall a. Stack a -> [a]
up Stack a
s forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse (forall a. Stack a -> [a]
down Stack a
s)
                        in  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (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 :: forall a. 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
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]
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
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
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)
ReadS [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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NextNoWrap -> NextNoWrap -> Bool
$c/= :: NextNoWrap -> NextNoWrap -> Bool
== :: NextNoWrap -> NextNoWrap -> Bool
$c== :: NextNoWrap -> NextNoWrap -> Bool
Eq, Int -> NextNoWrap -> ShowS
[NextNoWrap] -> ShowS
NextNoWrap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NextNoWrap] -> ShowS
$cshowList :: [NextNoWrap] -> ShowS
show :: NextNoWrap -> String
$cshow :: NextNoWrap -> String
showsPrec :: Int -> NextNoWrap -> ShowS
$cshowsPrec :: Int -> NextNoWrap -> ShowS
Show)
instance Message NextNoWrap

handle :: (LayoutClass l a, Message m) => l a -> m -> X (Maybe (l a))
handle :: forall (l :: * -> *) a m.
(LayoutClass l a, Message m) =>
l a -> m -> X (Maybe (l a))
handle l a
l m
m = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l (forall a. Message a => a -> SomeMessage
SomeMessage m
m)

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) = 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 -> (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, 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) <- 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
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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 -> forall a. Maybe a
Nothing
      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 <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
        Maybe (Choose l r a)
mlr' <- 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 <- 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 <- 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 = 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    | Just NextNoWrap
NextNoWrap <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
        Maybe (Choose l r a)
mlr' <- 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 <- 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 -> 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 <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (LR
R, l a
l, r a
r0, End
NoEnd)
                                    Maybe (r a)
Nothing -> 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 <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (LR
R, l a
l, r a
r0, End
NoEnd)
                         Maybe (r a)
Nothing -> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    | Just ChangeLayout
FirstLayout <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
        Maybe (Choose l r a)
mlr' <- 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 <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (LR
L,l a
l0,r a
r)
                          Maybe (l a)
Nothing -> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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' <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | This is same as the Choose combination operator.
(|||) :: l a -> r a -> ChooseWrapper l r a
||| :: forall (l :: * -> *) a (r :: * -> *).
l a -> r a -> ChooseWrapper l r a
(|||) l a
l r a
r = 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 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) -> ([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]
_) = 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) = 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) = forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused r Window
lay2 Maybe (Stack Window)
s2
    in  ([Window]
f1 forall a. [a] -> [a] -> [a]
++ [Window]
f2, String
"TMS: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Window]
f forall a. [a] -> [a] -> [a]
++ String
"::" forall a. [a] -> [a] -> [a]
++ String
str1 forall a. [a] -> [a] -> [a]
++ String
"--" 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]
_) = 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
_) = 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' = 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' = 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 -> forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> ([a], String)
getFocused l a
l Maybe (Stack a)
s
              LR
R -> 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 -> (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, forall (l :: * -> *) a.
GetFocused l a =>
l a -> Maybe (Stack a) -> l a
savFocused r a
r Maybe (Stack a)
s)
    in 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