{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}
{-# LANGUAGE StandaloneDeriving, FlexibleContexts, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, PatternGuards, Rank2Types #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Groups
-- Description :  Split windows in layout groups that are managed by another layout.
-- Copyright   :  Quentin Moser <moserq@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  orphaned
-- Stability   :  unstable
-- Portability :  unportable
--
-- Two-level layout with windows split in individual layout groups,
-- themselves managed by a user-provided layout.
--
-----------------------------------------------------------------------------

module XMonad.Layout.Groups ( -- * Usage
                              -- $usage
                              -- * Creation
                              group
                              -- * Messages
                            , GroupsMessage(..)
                            , ModifySpec
                            , ModifySpecX
                              -- ** Useful 'ModifySpec's
                            , swapUp
                            , swapDown
                            , swapMaster
                            , focusUp
                            , focusDown
                            , focusMaster
                            , swapGroupUp
                            , swapGroupDown
                            , swapGroupMaster
                            , focusGroupUp
                            , focusGroupDown
                            , focusGroupMaster
                            , moveToGroupUp
                            , moveToGroupDown
                            , moveToNewGroupUp
                            , moveToNewGroupDown
                            , splitGroup
                              -- * Types
                            , Groups
                            , Group(..)
                            , onZipper
                            , onLayout
                            , WithID
                            , sameID
                            ) where

import XMonad
import XMonad.Prelude hiding (group)
import qualified XMonad.StackSet as W

import XMonad.Util.Stack

import Control.Arrow ((>>>))

-- $usage
-- This module provides a layout combinator that allows you
-- to manage your windows in independent groups. You can provide
-- both the layout with which to arrange the windows inside each
-- group, and the layout with which the groups themselves will
-- be arranged on the screen.
--
-- The "XMonad.Layout.Groups.Examples" and "XMonad.Layout.Groups.Wmii"
-- modules contain examples of layouts that can be defined with this
-- combinator. They're also the recommended starting point
-- if you are a beginner and looking for something you can use easily.
--
-- One thing to note is that 'Groups'-based layout have their own
-- notion of the order of windows, which is completely separate
-- from XMonad's. For this reason, operations like 'XMonad.StackSet.SwapUp'
-- will have no visible effect, and those like 'XMonad.StackSet.focusUp'
-- will focus the windows in an unpredictable order. For a better way of
-- rearranging windows and moving focus in such a layout, see the
-- example 'ModifySpec's (to be passed to the 'Modify' message) provided
-- by this module.
--
-- If you use both 'Groups'-based and other layouts, The "XMonad.Layout.Groups.Helpers"
-- module provides actions that can work correctly with both, defined using
-- functions from "XMonad.Actions.MessageFeedback".

-- | Create a 'Groups' layout.
--
-- Note that the second parameter (the layout for arranging the
-- groups) is not used on 'Windows', but on 'Group's. For this
-- reason, you can only use layouts that don't specifically
-- need to manage 'Window's. This is obvious, when you think
-- about it.
group :: l Window -> l2 (Group l Window) -> Groups l l2 Window
group :: forall (l :: * -> *) (l2 :: * -> *).
l Window -> l2 (Group l Window) -> Groups l l2 Window
group l Window
l l2 (Group l Window)
l2 = forall (l :: * -> *) (l2 :: * -> *) a.
l a -> l2 (Group l a) -> Stack (Group l a) -> Uniq -> Groups l l2 a
Groups l Window
l l2 (Group l Window)
l2 Stack (Group l Window)
startingGroups (Integer -> Integer -> Uniq
U Integer
1 Integer
0)
    where startingGroups :: Stack (Group l Window)
startingGroups = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. a -> Zipper a
singletonZ forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID (Integer -> Integer -> Uniq
U Integer
0 Integer
0) l Window
l) forall a. Zipper a
emptyZ

-- * Stuff with unique keys

data Uniq = U Integer Integer
  deriving (Uniq -> Uniq -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Uniq -> Uniq -> Bool
$c/= :: Uniq -> Uniq -> Bool
== :: Uniq -> Uniq -> Bool
$c== :: Uniq -> Uniq -> Bool
Eq, Int -> Uniq -> ShowS
[Uniq] -> ShowS
Uniq -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Uniq] -> ShowS
$cshowList :: [Uniq] -> ShowS
show :: Uniq -> String
$cshow :: Uniq -> String
showsPrec :: Int -> Uniq -> ShowS
$cshowsPrec :: Int -> Uniq -> ShowS
Show, ReadPrec [Uniq]
ReadPrec Uniq
Int -> ReadS Uniq
ReadS [Uniq]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Uniq]
$creadListPrec :: ReadPrec [Uniq]
readPrec :: ReadPrec Uniq
$creadPrec :: ReadPrec Uniq
readList :: ReadS [Uniq]
$creadList :: ReadS [Uniq]
readsPrec :: Int -> ReadS Uniq
$creadsPrec :: Int -> ReadS Uniq
Read)

-- | From a seed, generate an infinite list of keys and a new
-- seed. All keys generated with this method will be different
-- provided you don't use 'gen' again with a key from the list.
-- (if you need to do that, see 'split' instead)
gen :: Uniq -> (Uniq, Stream Uniq)
gen :: Uniq -> (Uniq, Stream Uniq)
gen (U Integer
i1 Integer
i2) = (Integer -> Integer -> Uniq
U (Integer
i1forall a. Num a => a -> a -> a
+Integer
1) Integer
i2, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer -> Uniq
U Integer
i1) (forall l. IsList l => [Item l] -> l
fromList [Integer
i2..]))

-- | Split an infinite list into two. I ended up not
-- needing this, but let's keep it just in case.
-- split :: [a] -> ([a], [a])
-- split as = snd $ foldr step (True, ([], [])) as
--     where step a (True, (as1, as2)) = (False, (a:as1, as2))
--           step a (False, (as1, as2)) = (True, (as1, a:as2))

-- | Add a unique identity to a layout so we can
-- follow it around.
data WithID l a = ID { forall (l :: * -> *) a. WithID l a -> Uniq
getID :: Uniq
                     , forall (l :: * -> *) a. WithID l a -> l a
unID :: l a}
  deriving (Int -> WithID l a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: * -> *) a. Show (l a) => Int -> WithID l a -> ShowS
forall (l :: * -> *) a. Show (l a) => [WithID l a] -> ShowS
forall (l :: * -> *) a. Show (l a) => WithID l a -> String
showList :: [WithID l a] -> ShowS
$cshowList :: forall (l :: * -> *) a. Show (l a) => [WithID l a] -> ShowS
show :: WithID l a -> String
$cshow :: forall (l :: * -> *) a. Show (l a) => WithID l a -> String
showsPrec :: Int -> WithID l a -> ShowS
$cshowsPrec :: forall (l :: * -> *) a. Show (l a) => Int -> WithID l a -> ShowS
Show, ReadPrec [WithID l a]
ReadPrec (WithID l a)
ReadS [WithID l a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l :: * -> *) a. Read (l a) => ReadPrec [WithID l a]
forall (l :: * -> *) a. Read (l a) => ReadPrec (WithID l a)
forall (l :: * -> *) a. Read (l a) => Int -> ReadS (WithID l a)
forall (l :: * -> *) a. Read (l a) => ReadS [WithID l a]
readListPrec :: ReadPrec [WithID l a]
$creadListPrec :: forall (l :: * -> *) a. Read (l a) => ReadPrec [WithID l a]
readPrec :: ReadPrec (WithID l a)
$creadPrec :: forall (l :: * -> *) a. Read (l a) => ReadPrec (WithID l a)
readList :: ReadS [WithID l a]
$creadList :: forall (l :: * -> *) a. Read (l a) => ReadS [WithID l a]
readsPrec :: Int -> ReadS (WithID l a)
$creadsPrec :: forall (l :: * -> *) a. Read (l a) => Int -> ReadS (WithID l a)
Read)

-- | Compare the ids of two 'WithID' values
sameID :: WithID l a -> WithID l a -> Bool
sameID :: forall (l :: * -> *) a. WithID l a -> WithID l a -> Bool
sameID (ID Uniq
id1 l a
_) (ID Uniq
id2 l a
_) = Uniq
id1 forall a. Eq a => a -> a -> Bool
== Uniq
id2

instance Eq (WithID l a) where
    ID Uniq
id1 l a
_ == :: WithID l a -> WithID l a -> Bool
== ID Uniq
id2 l a
_ = Uniq
id1 forall a. Eq a => a -> a -> Bool
== Uniq
id2

instance LayoutClass l a => LayoutClass (WithID l) a where
    runLayout :: Workspace String (WithID l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (WithID l a))
runLayout ws :: Workspace String (WithID l a) a
ws@W.Workspace { layout :: forall i l a. Workspace i l a -> l
W.layout = ID Uniq
id l a
l } Rectangle
r
        = do ([(a, Rectangle)]
placements, Maybe (l a)
ml') <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (WithID l a) a
ws{ layout :: l a
W.layout = l a
l} Rectangle
r
             forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
placements, forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (l a)
ml')
    handleMessage :: WithID l a -> SomeMessage -> X (Maybe (WithID l a))
handleMessage (ID Uniq
id l a
l) SomeMessage
sm = do Maybe (l a)
ml' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
sm
                                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (l a)
ml'
    description :: WithID l a -> String
description (ID Uniq
_ l a
l) = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l a
l



-- * The 'Groups' layout


-- ** Datatypes

-- | A group of windows and its layout algorithm.
data Group l a = G { forall (l :: * -> *) a. Group l a -> WithID l a
gLayout :: WithID l a
                   , forall (l :: * -> *) a. Group l a -> Zipper a
gZipper :: Zipper a }
  deriving (Int -> Group l a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Int -> Group l a -> ShowS
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
[Group l a] -> ShowS
forall (l :: * -> *) a. (Show a, Show (l a)) => Group l a -> String
showList :: [Group l a] -> ShowS
$cshowList :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
[Group l a] -> ShowS
show :: Group l a -> String
$cshow :: forall (l :: * -> *) a. (Show a, Show (l a)) => Group l a -> String
showsPrec :: Int -> Group l a -> ShowS
$cshowsPrec :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Int -> Group l a -> ShowS
Show, ReadPrec [Group l a]
ReadPrec (Group l a)
ReadS [Group l a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec [Group l a]
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec (Group l a)
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
Int -> ReadS (Group l a)
forall (l :: * -> *) a. (Read a, Read (l a)) => ReadS [Group l a]
readListPrec :: ReadPrec [Group l a]
$creadListPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec [Group l a]
readPrec :: ReadPrec (Group l a)
$creadPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec (Group l a)
readList :: ReadS [Group l a]
$creadList :: forall (l :: * -> *) a. (Read a, Read (l a)) => ReadS [Group l a]
readsPrec :: Int -> ReadS (Group l a)
$creadsPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
Int -> ReadS (Group l a)
Read, Group l a -> Group l a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l :: * -> *) a. Eq a => Group l a -> Group l a -> Bool
/= :: Group l a -> Group l a -> Bool
$c/= :: forall (l :: * -> *) a. Eq a => Group l a -> Group l a -> Bool
== :: Group l a -> Group l a -> Bool
$c== :: forall (l :: * -> *) a. Eq a => Group l a -> Group l a -> Bool
Eq)

onLayout :: (WithID l a -> WithID l a) -> Group l a -> Group l a
onLayout :: forall (l :: * -> *) a.
(WithID l a -> WithID l a) -> Group l a -> Group l a
onLayout WithID l a -> WithID l a
f Group l a
g = Group l a
g { gLayout :: WithID l a
gLayout = WithID l a -> WithID l a
f forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. Group l a -> WithID l a
gLayout Group l a
g }

onZipper :: (Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper :: forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper Zipper a -> Zipper a
f Group l a
g = Group l a
g { gZipper :: Zipper a
gZipper = Zipper a -> Zipper a
f forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. Group l a -> Zipper a
gZipper Group l a
g }

-- | The type of our layouts.
data Groups l l2 a = Groups { -- | The starting layout for new groups
                              forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout :: l a
                              -- | The layout for placing each group on the screen
                            , forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> l2 (Group l a)
partitioner :: l2 (Group l a)
                              -- | The window groups
                            , forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups :: W.Stack (Group l a)
                              -- | A seed for generating unique ids
                            , forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> Uniq
seed :: Uniq
                            }

deriving instance (Show a, Show (l a), Show (l2 (Group l a))) => Show (Groups l l2 a)
deriving instance (Read a, Read (l a), Read (l2 (Group l a))) => Read (Groups l l2 a)

-- | Messages accepted by 'Groups'-based layouts.
-- All other messages are forwarded to the layout of the currently
-- focused subgroup (as if they had been wrapped in 'ToFocused').
data GroupsMessage = ToEnclosing SomeMessage -- ^ Send a message to the enclosing layout
                                             -- (the one that places the groups themselves)
                   | ToGroup Int SomeMessage -- ^ Send a message to the layout for nth group
                                             -- (starting at 0)
                   | ToFocused SomeMessage -- ^ Send a message to the layout for the focused
                                           -- group
                   | ToAll SomeMessage -- ^ Send a message to all the sub-layouts
                   | Refocus -- ^ Refocus the window which should be focused according
                             -- to the layout.
                   | Modify ModifySpec -- ^ Modify the ordering\/grouping\/focusing
                                       -- of windows according to a 'ModifySpec'
                   | ModifyX ModifySpecX -- ^ Same as 'Modify', but within the 'X' monad

instance Show GroupsMessage where
    show :: GroupsMessage -> String
show (ToEnclosing SomeMessage
_) = String
"ToEnclosing {...}"
    show (ToGroup Int
i SomeMessage
_) = String
"ToGroup "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Int
iforall a. [a] -> [a] -> [a]
++String
" {...}"
    show (ToFocused SomeMessage
_) = String
"ToFocused {...}"
    show (ToAll SomeMessage
_) = String
"ToAll {...}"
    show GroupsMessage
Refocus = String
"Refocus"
    show (Modify ModifySpec
_) = String
"Modify {...}"
    show (ModifyX ModifySpecX
_) = String
"ModifyX {...}"

instance Message GroupsMessage

modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a))
             -> Groups l l2 a -> Groups l l2 a
modifyGroups :: forall (l :: * -> *) a (l2 :: * -> *).
(Zipper (Group l a) -> Zipper (Group l a))
-> Groups l l2 a -> Groups l l2 a
modifyGroups Zipper (Group l a) -> Zipper (Group l a)
f Groups l l2 a
g = let (Uniq
seed', Uniq
ident :~ Stream Uniq
_) = Uniq -> (Uniq, Stream Uniq)
gen (forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> Uniq
seed Groups l l2 a
g)
                       defaultGroups :: Stack (Group l a)
defaultGroups = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. a -> Zipper a
singletonZ forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
ident forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 a
g) forall a. Zipper a
emptyZ
                   in Groups l l2 a
g { groups :: Stack (Group l a)
groups = forall a. a -> Maybe a -> a
fromMaybe Stack (Group l a)
defaultGroups forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper (Group l a) -> Zipper (Group l a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 a
g
                        , seed :: Uniq
seed = Uniq
seed' }

modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a)))
              -> Groups l l2 a -> X (Groups l l2 a)
modifyGroupsX :: forall (l :: * -> *) a (l2 :: * -> *).
(Zipper (Group l a) -> X (Zipper (Group l a)))
-> Groups l l2 a -> X (Groups l l2 a)
modifyGroupsX Zipper (Group l a) -> X (Zipper (Group l a))
f Groups l l2 a
g = do
  let (Uniq
seed', Uniq
ident :~ Stream Uniq
_) = Uniq -> (Uniq, Stream Uniq)
gen (forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> Uniq
seed Groups l l2 a
g)
      defaultGroups :: Stack (Group l a)
defaultGroups = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. a -> Zipper a
singletonZ forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
ident forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 a
g) forall a. Zipper a
emptyZ
  Zipper (Group l a)
g' <- Zipper (Group l a) -> X (Zipper (Group l a))
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 a
g
  forall (m :: * -> *) a. Monad m => a -> m a
return Groups l l2 a
g { groups :: Stack (Group l a)
groups = forall a. a -> Maybe a -> a
fromMaybe Stack (Group l a)
defaultGroups Zipper (Group l a)
g', seed :: Uniq
seed = Uniq
seed' }

-- ** Readaptation

-- | Adapt our groups to a new stack.
-- This algorithm handles window additions and deletions correctly,
-- ignores changes in window ordering, and tries to react to any
-- other stack changes as gracefully as possible.
readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a
readapt :: forall a (l :: * -> *) (l2 :: * -> *).
Eq a =>
Zipper a -> Groups l l2 a -> Groups l l2 a
readapt Zipper a
z Groups l l2 a
g = let mf :: Maybe a
mf = forall a. Zipper a -> Maybe a
getFocusZ Zipper a
z
                  (Uniq
seed', Uniq
ident :~ Stream Uniq
_) = Uniq -> (Uniq, Stream Uniq)
gen forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> Uniq
seed Groups l l2 a
g
                  g' :: Groups l l2 a
g' = Groups l l2 a
g { seed :: Uniq
seed = Uniq
seed' }
              in forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (l :: * -> *) a (l2 :: * -> *).
(Zipper (Group l a) -> Zipper (Group l a))
-> Groups l l2 a -> Groups l l2 a
modifyGroups Groups l l2 a
g' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Zipper a -> Zipper b
mapZ_ (forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper forall a b. (a -> b) -> a -> b
$ forall a. Eq a => Zipper a -> Zipper a -> Zipper a
removeDeleted Zipper a
z)
                                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall {a}. (a -> Bool) -> Maybe (Stack a) -> Maybe (Stack a)
filterKeepLast (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a. Group l a -> Zipper a
gZipper)
                                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a (l :: * -> *).
Eq a =>
[a] -> Zipper (Group l a) -> (Zipper (Group l a), [a])
findNewWindows (forall a. Maybe (Stack a) -> [a]
W.integrate' Zipper a
z)
                                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (l :: * -> *) a.
WithID l a -> (Zipper (Group l a), [a]) -> Zipper (Group l a)
addWindows (forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
ident forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 a
g)
                                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a (l :: * -> *).
Eq a =>
Maybe a -> Zipper (Group l a) -> Zipper (Group l a)
focusGroup Maybe a
mf
                                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ (forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper forall a b. (a -> b) -> a -> b
$ forall a. Eq a => Maybe a -> Zipper a -> Zipper a
focusWindow Maybe a
mf)
    where filterKeepLast :: (a -> Bool) -> Maybe (Stack a) -> Maybe (Stack a)
filterKeepLast a -> Bool
_ Maybe (Stack a)
Nothing = forall a. Maybe a
Nothing
          filterKeepLast a -> Bool
f z :: Maybe (Stack a)
z@(Just Stack a
s) =  forall {a}. (a -> Bool) -> Maybe (Stack a) -> Maybe (Stack a)
filterZ_ a -> Bool
f Maybe (Stack a)
z
                                     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Zipper a
singletonZ (forall a. Stack a -> a
W.focus Stack a
s)

-- | Remove the windows from a group which are no longer present in
-- the stack.
removeDeleted :: Eq a => Zipper a -> Zipper a -> Zipper a
removeDeleted :: forall a. Eq a => Zipper a -> Zipper a -> Zipper a
removeDeleted Zipper a
z = forall {a}. (a -> Bool) -> Maybe (Stack a) -> Maybe (Stack a)
filterZ_ (forall a. Eq a => a -> Zipper a -> Bool
`elemZ` Zipper a
z)

-- | Identify the windows not already in a group.
findNewWindows :: Eq a => [a] -> Zipper (Group l a)
               -> (Zipper (Group l a), [a])
findNewWindows :: forall a (l :: * -> *).
Eq a =>
[a] -> Zipper (Group l a) -> (Zipper (Group l a), [a])
findNewWindows [a]
as Zipper (Group l a)
gs = (Zipper (Group l a)
gs, forall a b. (a -> b -> b) -> b -> Zipper a -> b
foldrZ_ forall {a} {l :: * -> *}. Eq a => Group l a -> [a] -> [a]
removePresent [a]
as Zipper (Group l a)
gs)
    where removePresent :: Group l a -> [a] -> [a]
removePresent Group l a
g = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => a -> Zipper a -> Bool
elemZ (forall (l :: * -> *) a. Group l a -> Zipper a
gZipper Group l a
g))

-- | Add windows to the focused group. If you need to create one,
-- use the given layout and an id from the given list.
addWindows :: WithID l a -> (Zipper (Group l a), [a]) -> Zipper (Group l a)
addWindows :: forall (l :: * -> *) a.
WithID l a -> (Zipper (Group l a), [a]) -> Zipper (Group l a)
addWindows WithID l a
l (Zipper (Group l a)
Nothing, [a]
as) = forall a. a -> Zipper a
singletonZ forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l a
l (forall a. [a] -> Maybe (Stack a)
W.differentiate [a]
as)
addWindows WithID l a
_ (Zipper (Group l a)
z, [a]
as) = forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ (forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper Zipper a -> Zipper a
add) Zipper (Group l a)
z
    where add :: Zipper a -> Zipper a
add Zipper a
z = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> Zipper a -> Zipper a
insertUpZ) Zipper a
z [a]
as

-- | Focus the group containing the given window
focusGroup :: Eq a => Maybe a -> Zipper (Group l a) -> Zipper (Group l a)
focusGroup :: forall a (l :: * -> *).
Eq a =>
Maybe a -> Zipper (Group l a) -> Zipper (Group l a)
focusGroup Maybe a
Nothing = forall a. a -> a
id
focusGroup (Just a
a) = forall a. [Either a a] -> Zipper a
fromTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> a -> Either a a
tagBy forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> Zipper a -> Bool
elemZ a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a. Group l a -> Zipper a
gZipper) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe (Stack a) -> [a]
W.integrate'

-- | Focus the given window
focusWindow :: Eq a => Maybe a -> Zipper a -> Zipper a
focusWindow :: forall a. Eq a => Maybe a -> Zipper a -> Zipper a
focusWindow Maybe a
Nothing = forall a. a -> a
id
focusWindow (Just a
a) = forall a. [Either a a] -> Zipper a
fromTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> a -> Either a a
tagBy (forall a. Eq a => a -> a -> Bool
==a
a)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe (Stack a) -> [a]
W.integrate'


-- * Interface

-- ** Layout instance

instance (LayoutClass l Window, LayoutClass l2 (Group l Window))
    => LayoutClass (Groups l l2) Window where

        description :: Groups l l2 Window -> String
description (Groups l Window
_ l2 (Group l Window)
p Stack (Group l Window)
gs Uniq
_) = String
s1forall a. [a] -> [a] -> [a]
++String
" by "forall a. [a] -> [a] -> [a]
++String
s2
            where s1 :: String
s1 = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. Group l a -> WithID l a
gLayout forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> a
W.focus Stack (Group l Window)
gs
                  s2 :: String
s2 = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 (Group l Window)
p

        runLayout :: Workspace String (Groups l l2 Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (Groups l l2 Window))
runLayout ws :: Workspace String (Groups l l2 Window) Window
ws@(W.Workspace String
_ Groups l l2 Window
_l Maybe (Stack Window)
z) Rectangle
r = let l :: Groups l l2 Window
l = forall a (l :: * -> *) (l2 :: * -> *).
Eq a =>
Zipper a -> Groups l l2 a -> Groups l l2 a
readapt Maybe (Stack Window)
z Groups l l2 Window
_l in
            do ([(Group l Window, Rectangle)]
areas, Maybe (l2 (Group l Window))
mpart') <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (Groups l l2 Window) Window
ws { layout :: l2 (Group l Window)
W.layout = forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> l2 (Group l a)
partitioner Groups l l2 Window
l
                                               , stack :: Maybe (Stack (Group l Window))
W.stack = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 Window
l } Rectangle
r

               [([(Window, Rectangle)], Maybe (WithID l Window))]
results <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Group l Window, Rectangle)]
areas forall a b. (a -> b) -> a -> b
$ \(Group l Window
g, Rectangle
r') -> forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (Groups l l2 Window) Window
ws { layout :: WithID l Window
W.layout = forall (l :: * -> *) a. Group l a -> WithID l a
gLayout Group l Window
g
                                                                , stack :: Maybe (Stack Window)
W.stack = forall (l :: * -> *) a. Group l a -> Zipper a
gZipper Group l Window
g } Rectangle
r'

               let hidden :: [WithID l Window]
hidden = forall a b. (a -> b) -> [a] -> [b]
map forall (l :: * -> *) a. Group l a -> WithID l a
gLayout (forall a. Stack a -> [a]
W.integrate forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 Window
_l) forall a. Eq a => [a] -> [a] -> [a]
\\ forall a b. (a -> b) -> [a] -> [b]
map (forall (l :: * -> *) a. Group l a -> WithID l a
gLayout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Group l Window, Rectangle)]
areas
               [Maybe (WithID l Window)]
hidden' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide) [WithID l Window]
hidden

               let placements :: [(Window, Rectangle)]
placements = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> a
fst [([(Window, Rectangle)], Maybe (WithID l Window))]
results
                   newL :: Maybe (Groups l l2 Window)
newL = forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a
-> Maybe (l2 (Group l a))
-> [Maybe (WithID l a)]
-> Maybe (Groups l l2 a)
justMakeNew Groups l l2 Window
l Maybe (l2 (Group l Window))
mpart' (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [([(Window, Rectangle)], Maybe (WithID l Window))]
results forall a. [a] -> [a] -> [a]
++ [Maybe (WithID l Window)]
hidden')

               forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
placements, Maybe (Groups l l2 Window)
newL)

        handleMessage :: Groups l l2 Window -> SomeMessage -> X (Maybe (Groups l l2 Window))
handleMessage l :: Groups l l2 Window
l@(Groups l Window
_ l2 (Group l Window)
p Stack (Group l Window)
_ Uniq
_) SomeMessage
sm | Just (ToEnclosing SomeMessage
sm') <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm
            = do Maybe (l2 (Group l Window))
mp' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 (Group l Window)
p SomeMessage
sm'
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a
-> Maybe (l2 (Group l a))
-> [Maybe (WithID l a)]
-> Maybe (Groups l l2 a)
maybeMakeNew Groups l l2 Window
l Maybe (l2 (Group l Window))
mp' []

        handleMessage l :: Groups l l2 Window
l@(Groups l Window
_ l2 (Group l Window)
p Stack (Group l Window)
gs Uniq
_) SomeMessage
sm | Just (ToAll SomeMessage
sm') <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm
            = do Maybe (l2 (Group l Window))
mp' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 (Group l Window)
p SomeMessage
sm'
                 Zipper (Maybe (WithID l Window))
mg's <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Zipper a -> m (Zipper b)
mapZM_ (forall {l :: * -> *} {a}.
LayoutClass l a =>
SomeMessage -> Group l a -> X (Maybe (WithID l a))
handle SomeMessage
sm') forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Stack (Group l Window)
gs
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a
-> Maybe (l2 (Group l a))
-> [Maybe (WithID l a)]
-> Maybe (Groups l l2 a)
maybeMakeNew Groups l l2 Window
l Maybe (l2 (Group l Window))
mp' forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Stack a) -> [a]
W.integrate' Zipper (Maybe (WithID l Window))
mg's
            where handle :: SomeMessage -> Group l a -> X (Maybe (WithID l a))
handle SomeMessage
sm (G WithID l a
l Zipper a
_) = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage WithID l a
l SomeMessage
sm

        handleMessage Groups l l2 Window
l SomeMessage
sm | Just LayoutMessages
a <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm
            = let _rightType :: Bool
_rightType = LayoutMessages
a forall a. Eq a => a -> a -> Bool
== LayoutMessages
Hide -- Is there a better-looking way
                                         -- of doing this?
              in forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Groups l l2 Window
l forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage forall a b. (a -> b) -> a -> b
$ SomeMessage -> GroupsMessage
ToAll SomeMessage
sm

        handleMessage l :: Groups l l2 Window
l@(Groups l Window
_ l2 (Group l Window)
_ Stack (Group l Window)
z Uniq
_) SomeMessage
sm = case forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm of
              Just (ToFocused SomeMessage
sm') -> do [Maybe (WithID l Window)]
mg's <- forall a. Maybe (Stack a) -> [a]
W.integrate' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l :: * -> *} {a}.
LayoutClass l a =>
SomeMessage -> Stack (Group l a) -> X (Zipper (Maybe (WithID l a)))
handleOnFocused SomeMessage
sm' Stack (Group l Window)
z
                                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a
-> Maybe (l2 (Group l a))
-> [Maybe (WithID l a)]
-> Maybe (Groups l l2 a)
maybeMakeNew Groups l l2 Window
l forall a. Maybe a
Nothing [Maybe (WithID l Window)]
mg's
              Just (ToGroup Int
i SomeMessage
sm') -> do [Maybe (WithID l Window)]
mg's <- forall {l :: * -> *} {a} {p}.
(LayoutClass l a, Num p, Enum p, Eq p) =>
p -> SomeMessage -> Stack (Group l a) -> X [Maybe (WithID l a)]
handleOnIndex Int
i SomeMessage
sm' Stack (Group l Window)
z
                                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a
-> Maybe (l2 (Group l a))
-> [Maybe (WithID l a)]
-> Maybe (Groups l l2 a)
maybeMakeNew Groups l l2 Window
l forall a. Maybe a
Nothing [Maybe (WithID l Window)]
mg's
              Just (Modify ModifySpec
spec) -> case forall (l :: * -> *) (l2 :: * -> *).
ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
applySpec ModifySpec
spec Groups l l2 Window
l of
                                      Just Groups l l2 Window
l' -> forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus Groups l l2 Window
l'
                                      Maybe (Groups l l2 Window)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
              Just (ModifyX ModifySpecX
spec) -> do Maybe (Groups l l2 Window)
ml' <- forall (l :: * -> *) (l2 :: * -> *).
ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
applySpecX ModifySpecX
spec Groups l l2 Window
l
                                        forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Groups l l2 Window)
ml' (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus)
                                        forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Groups l l2 Window)
ml' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just Groups l l2 Window
l)
              Just GroupsMessage
Refocus -> forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus Groups l l2 Window
l
              Just GroupsMessage
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
              Maybe GroupsMessage
Nothing -> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Groups l l2 Window
l forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage (SomeMessage -> GroupsMessage
ToFocused SomeMessage
sm)
            where handleOnFocused :: SomeMessage -> Stack (Group l a) -> X (Zipper (Maybe (WithID l a)))
handleOnFocused SomeMessage
sm Stack (Group l a)
z = forall (m :: * -> *) a b.
Monad m =>
(Bool -> a -> m b) -> Zipper a -> m (Zipper b)
mapZM forall {l :: * -> *} {a}.
LayoutClass l a =>
Bool -> Group l a -> X (Maybe (WithID l a))
step forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Stack (Group l a)
z
                      where step :: Bool -> Group l a -> X (Maybe (WithID l a))
step Bool
True (G WithID l a
l Zipper a
_) = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage WithID l a
l SomeMessage
sm
                            step Bool
False Group l a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                  handleOnIndex :: p -> SomeMessage -> Stack (Group l a) -> X [Maybe (WithID l a)]
handleOnIndex p
i SomeMessage
sm Stack (Group l a)
z = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {l :: * -> *} {a}.
LayoutClass l a =>
(p, Group l a) -> X (Maybe (WithID l a))
step forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [p
0..] forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> [a]
W.integrate Stack (Group l a)
z
                      where step :: (p, Group l a) -> X (Maybe (WithID l a))
step (p
j, G WithID l a
l Zipper a
_) | p
i forall a. Eq a => a -> a -> Bool
== p
j = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage WithID l a
l SomeMessage
sm
                            step (p, Group l a)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing


justMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)]
            -> Maybe (Groups l l2 a)
justMakeNew :: forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a
-> Maybe (l2 (Group l a))
-> [Maybe (WithID l a)]
-> Maybe (Groups l l2 a)
justMakeNew Groups l l2 a
g Maybe (l2 (Group l a))
mpart' [Maybe (WithID l a)]
ml's = forall a. a -> Maybe a
Just Groups l l2 a
g { partitioner :: l2 (Group l a)
partitioner = forall a. a -> Maybe a -> a
fromMaybe (forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> l2 (Group l a)
partitioner Groups l l2 a
g) Maybe (l2 (Group l a))
mpart'
                                   , groups :: Stack (Group l a)
groups = forall {l :: * -> *} {a}.
Stack (Group l a) -> [Maybe (WithID l a)] -> Stack (Group l a)
combine (forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 a
g) [Maybe (WithID l a)]
ml's }
    where combine :: Stack (Group l a) -> [Maybe (WithID l a)] -> Stack (Group l a)
combine Stack (Group l a)
z [Maybe (WithID l a)]
ml's = let table :: [(Uniq, l a)]
table = forall a b. (a -> b) -> [a] -> [b]
map (\(ID Uniq
id l a
a) -> (Uniq
id, l a
a)) forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe (WithID l a)]
ml's
                           in forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {a} {b}. (a -> b) -> Stack a -> Stack b
mapS_ Stack (Group l a)
z forall a b. (a -> b) -> a -> b
$ \(G (ID Uniq
id l a
l) Zipper a
ws) -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Uniq
id [(Uniq, l a)]
table of
                                        Maybe (l a)
Nothing -> forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id l a
l) Zipper a
ws
                                        Just l a
l' -> forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id l a
l') Zipper a
ws
          mapS_ :: (a -> b) -> Stack a -> Stack b
mapS_ a -> b
f = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Zipper a -> Zipper b
mapZ_ a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just


maybeMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)]
             -> Maybe (Groups l l2 a)
maybeMakeNew :: forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a
-> Maybe (l2 (Group l a))
-> [Maybe (WithID l a)]
-> Maybe (Groups l l2 a)
maybeMakeNew Groups l l2 a
_ Maybe (l2 (Group l a))
Nothing [Maybe (WithID l a)]
ml's | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Maybe a -> Bool
isNothing [Maybe (WithID l a)]
ml's = forall a. Maybe a
Nothing
maybeMakeNew Groups l l2 a
g Maybe (l2 (Group l a))
mpart' [Maybe (WithID l a)]
ml's = forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a
-> Maybe (l2 (Group l a))
-> [Maybe (WithID l a)]
-> Maybe (Groups l l2 a)
justMakeNew Groups l l2 a
g Maybe (l2 (Group l a))
mpart' [Maybe (WithID l a)]
ml's

refocus :: Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus :: forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus Groups l l2 Window
g =
  let mw :: Maybe Window
mw = (forall a. Zipper a -> Maybe a
getFocusZ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a. Group l a -> Zipper a
gZipper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> a
W.focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups) Groups l l2 Window
g
  in  Groups l l2 Window
g forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe Window
mw forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Window
mw ((WindowSet -> WindowSet) -> X ()
modifyWindowSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow)

-- ** ModifySpec type

-- | Type of functions describing modifications to a 'Groups' layout. They
-- are transformations on 'Zipper's of groups.
--
-- Things you shouldn't do:
--
-- * Forge new windows (they will be ignored)
--
-- * Duplicate windows (whatever happens is your problem)
--
-- * Remove windows (they will be added again)
--
-- * Duplicate layouts (only one will be kept, the rest will
--   get the base layout)
--
-- Note that 'ModifySpec' is a rank-2 type (indicating that 'ModifySpec's must
-- be polymorphic in the layout type), so if you define functions taking
-- 'ModifySpec's as arguments, or returning them,  you'll need to write a type
-- signature and add @{-# LANGUAGE Rank2Types #-}@ at the beginning
type ModifySpec = forall l. WithID l Window
                -> Zipper (Group l Window)
                -> Zipper (Group l Window)

-- ** ModifierSpecX type

-- | This is the same as 'ModifySpec', but it allows the function to use
-- actions inside the 'X' monad. This is useful, for example, if the function
-- has to make decisions based on the results of a 'runQuery'.
type ModifySpecX = forall l. WithID l Window
                 -> Zipper (Group l Window)
                 -> X (Zipper (Group l Window))

-- | Apply a ModifySpec.
applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
applySpec :: forall (l :: * -> *) (l2 :: * -> *).
ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
applySpec ModifySpec
f Groups l l2 Window
g =
    let (Uniq
seed', Uniq
ident :~ Stream Uniq
ids) =  Uniq -> (Uniq, Stream Uniq)
gen forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> Uniq
seed Groups l l2 Window
g -- gen generates an infinite list
        g' :: Groups l l2 Window
g' = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (l :: * -> *) a (l2 :: * -> *).
(Zipper (Group l a) -> Zipper (Group l a))
-> Groups l l2 a -> Groups l l2 a
modifyGroups Groups l l2 Window
g forall a b. (a -> b) -> a -> b
$ ModifySpec
f (forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
ident forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 Window
g)
                                   forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. Zipper a -> [Either a a]
toTags
                                   forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window
-> Either (Group l Window) (Group l Window)
-> ((Stream Uniq, [Uniq]),
    [Either (Group l Window) (Group l Window)])
-> ((Stream Uniq, [Uniq]),
    [Either (Group l Window) (Group l Window)])
reID Groups l l2 Window
g) ((Stream Uniq
ids, []), [])
                                   forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. (a, b) -> b
snd
                                   forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. [Either a a] -> Zipper a
fromTags
    in if forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 Window
g forall a. Eq a => a -> a -> Bool
== forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 Window
g'
       then forall a. Maybe a
Nothing
       else forall a. a -> Maybe a
Just Groups l l2 Window
g' { seed :: Uniq
seed = Uniq
seed' }

applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
applySpecX :: forall (l :: * -> *) (l2 :: * -> *).
ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
applySpecX ModifySpecX
f Groups l l2 Window
g = do
    let (Uniq
seed', Uniq
ident :~ Stream Uniq
ids) = Uniq -> (Uniq, Stream Uniq)
gen forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> Uniq
seed Groups l l2 Window
g -- gen generates an infinite list
    Groups l l2 Window
g' <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (l :: * -> *) a (l2 :: * -> *).
(Zipper (Group l a) -> X (Zipper (Group l a)))
-> Groups l l2 a -> X (Groups l l2 a)
modifyGroupsX Groups l l2 Window
g forall a b. (a -> b) -> a -> b
$ ModifySpecX
f (forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
ident forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 Window
g)
                                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Zipper a -> [Either a a]
toTags
                                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window
-> Either (Group l Window) (Group l Window)
-> ((Stream Uniq, [Uniq]),
    [Either (Group l Window) (Group l Window)])
-> ((Stream Uniq, [Uniq]),
    [Either (Group l Window) (Group l Window)])
reID Groups l l2 Window
g) ((Stream Uniq
ids, []), []))
                                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd
                                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Either a a] -> Zipper a
fromTags
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 Window
g forall a. Eq a => a -> a -> Bool
== forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 Window
g'
             then forall a. Maybe a
Nothing
             else forall a. a -> Maybe a
Just Groups l l2 Window
g' { seed :: Uniq
seed = Uniq
seed' }

reID :: Groups l l2 Window
     -> Either (Group l Window) (Group l Window)
     -> ((Stream Uniq, [Uniq]), [Either (Group l Window) (Group l Window)])
     -> ((Stream Uniq, [Uniq]), [Either (Group l Window) (Group l Window)])
reID :: forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window
-> Either (Group l Window) (Group l Window)
-> ((Stream Uniq, [Uniq]),
    [Either (Group l Window) (Group l Window)])
-> ((Stream Uniq, [Uniq]),
    [Either (Group l Window) (Group l Window)])
reID Groups l l2 Window
g Either (Group l Window) (Group l Window)
eg ((Uniq
ident :~ Stream Uniq
ids, [Uniq]
seen), [Either (Group l Window) (Group l Window)]
egs)
    | Uniq
myID forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Uniq]
seen = ((Stream Uniq
ids, [Uniq]
seen), forall a b. (a -> b) -> Either a a -> Either b b
mapE_ (forall {l :: * -> *}. Uniq -> Group l Window -> Group l Window
setID Uniq
ident) Either (Group l Window) (Group l Window)
egforall a. a -> [a] -> [a]
:[Either (Group l Window) (Group l Window)]
egs)
    | Bool
otherwise = ((Uniq
ident forall a. a -> Stream a -> Stream a
:~ Stream Uniq
ids, Uniq
myIDforall a. a -> [a] -> [a]
:[Uniq]
seen), Either (Group l Window) (Group l Window)
egforall a. a -> [a] -> [a]
:[Either (Group l Window) (Group l Window)]
egs)
  where myID :: Uniq
myID = forall (l :: * -> *) a. WithID l a -> Uniq
getID forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. Group l a -> WithID l a
gLayout forall a b. (a -> b) -> a -> b
$ forall a. Either a a -> a
fromE Either (Group l Window) (Group l Window)
eg
        setID :: Uniq -> Group l Window -> Group l Window
setID Uniq
id (G (ID Uniq
_ l Window
_) Maybe (Stack Window)
z) = forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 Window
g) Maybe (Stack Window)
z

-- ** Misc. ModifySpecs

-- | helper
onFocused :: (Zipper Window -> Zipper Window) -> ModifySpec
onFocused :: (Maybe (Stack Window) -> Maybe (Stack Window)) -> ModifySpec
onFocused Maybe (Stack Window) -> Maybe (Stack Window)
f WithID l Window
_ = forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ (forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper Maybe (Stack Window) -> Maybe (Stack Window)
f)

-- | Swap the focused window with the previous one.
swapUp :: ModifySpec
swapUp :: ModifySpec
swapUp = (Maybe (Stack Window) -> Maybe (Stack Window)) -> ModifySpec
onFocused forall a. Zipper a -> Zipper a
swapUpZ

-- | Swap the focused window with the next one.
swapDown :: ModifySpec
swapDown :: ModifySpec
swapDown = (Maybe (Stack Window) -> Maybe (Stack Window)) -> ModifySpec
onFocused forall a. Zipper a -> Zipper a
swapDownZ

-- | Swap the focused window with the (group's) master
-- window.
swapMaster :: ModifySpec
swapMaster :: ModifySpec
swapMaster = (Maybe (Stack Window) -> Maybe (Stack Window)) -> ModifySpec
onFocused forall a. Zipper a -> Zipper a
swapMasterZ

-- | Swap the focused group with the previous one.
swapGroupUp :: ModifySpec
swapGroupUp :: ModifySpec
swapGroupUp WithID l Window
_ = forall a. Zipper a -> Zipper a
swapUpZ

-- | Swap the focused group with the next one.
swapGroupDown :: ModifySpec
swapGroupDown :: ModifySpec
swapGroupDown WithID l Window
_ = forall a. Zipper a -> Zipper a
swapDownZ

-- | Swap the focused group with the master group.
swapGroupMaster :: ModifySpec
swapGroupMaster :: ModifySpec
swapGroupMaster WithID l Window
_ = forall a. Zipper a -> Zipper a
swapMasterZ

-- | Move focus to the previous window in the group.
focusUp :: ModifySpec
focusUp :: ModifySpec
focusUp = (Maybe (Stack Window) -> Maybe (Stack Window)) -> ModifySpec
onFocused forall a. Zipper a -> Zipper a
focusUpZ

-- | Move focus to the next window in the group.
focusDown :: ModifySpec
focusDown :: ModifySpec
focusDown = (Maybe (Stack Window) -> Maybe (Stack Window)) -> ModifySpec
onFocused forall a. Zipper a -> Zipper a
focusDownZ

-- | Move focus to the group's master window.
focusMaster :: ModifySpec
focusMaster :: ModifySpec
focusMaster = (Maybe (Stack Window) -> Maybe (Stack Window)) -> ModifySpec
onFocused forall a. Zipper a -> Zipper a
focusMasterZ

-- | Move focus to the previous group.
focusGroupUp :: ModifySpec
focusGroupUp :: ModifySpec
focusGroupUp WithID l Window
_ = forall a. Zipper a -> Zipper a
focusUpZ

-- | Move focus to the next group.
focusGroupDown :: ModifySpec
focusGroupDown :: ModifySpec
focusGroupDown WithID l Window
_ = forall a. Zipper a -> Zipper a
focusDownZ

-- | Move focus to the master group.
focusGroupMaster :: ModifySpec
focusGroupMaster :: ModifySpec
focusGroupMaster WithID l Window
_ = forall a. Zipper a -> Zipper a
focusMasterZ

-- | helper
_removeFocused :: W.Stack a -> (a, Zipper a)
_removeFocused :: forall a. Stack a -> (a, Zipper a)
_removeFocused (W.Stack a
f (a
u:[a]
up) [a]
down) = (a
f, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
W.Stack a
u [a]
up [a]
down)
_removeFocused (W.Stack a
f [] (a
d:[a]
down)) = (a
f, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
W.Stack a
d [] [a]
down)
_removeFocused (W.Stack a
f [] []) = (a
f, forall a. Maybe a
Nothing)

-- helper
_moveToNewGroup :: WithID l Window -> W.Stack (Group l Window)
                -> (Group l Window -> Zipper (Group l Window)
                                   -> Zipper (Group l Window))
                -> Zipper (Group l Window)
_moveToNewGroup :: forall (l :: * -> *).
WithID l Window
-> Stack (Group l Window)
-> (Group l Window
    -> Zipper (Group l Window) -> Zipper (Group l Window))
-> Zipper (Group l Window)
_moveToNewGroup WithID l Window
l0 Stack (Group l Window)
s Group l Window
-> Zipper (Group l Window) -> Zipper (Group l Window)
insertX | G WithID l Window
l (Just Stack Window
f) <- forall a. Stack a -> a
W.focus Stack (Group l Window)
s
    = let (Window
w, Maybe (Stack Window)
f') = forall a. Stack a -> (a, Zipper a)
_removeFocused Stack Window
f
          s' :: Stack (Group l Window)
s' = Stack (Group l Window)
s { focus :: Group l Window
W.focus = forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l Maybe (Stack Window)
f' }
      in Group l Window
-> Zipper (Group l Window) -> Zipper (Group l Window)
insertX (forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l0 forall a b. (a -> b) -> a -> b
$ forall a. a -> Zipper a
singletonZ Window
w) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Stack (Group l Window)
s'
_moveToNewGroup WithID l Window
_ Stack (Group l Window)
s Group l Window
-> Zipper (Group l Window) -> Zipper (Group l Window)
_ = forall a. a -> Maybe a
Just Stack (Group l Window)
s

-- | Move the focused window to a new group before the current one.
moveToNewGroupUp :: ModifySpec
moveToNewGroupUp :: ModifySpec
moveToNewGroupUp WithID l Window
_ Maybe (Stack (Group l Window))
Nothing = forall a. Maybe a
Nothing
moveToNewGroupUp WithID l Window
l0 (Just Stack (Group l Window)
s) = forall (l :: * -> *).
WithID l Window
-> Stack (Group l Window)
-> (Group l Window
    -> Zipper (Group l Window) -> Zipper (Group l Window))
-> Zipper (Group l Window)
_moveToNewGroup WithID l Window
l0 Stack (Group l Window)
s forall a. a -> Zipper a -> Zipper a
insertUpZ

-- | Move the focused window to a new group after the current one.
moveToNewGroupDown :: ModifySpec
moveToNewGroupDown :: ModifySpec
moveToNewGroupDown WithID l Window
_ Maybe (Stack (Group l Window))
Nothing = forall a. Maybe a
Nothing
moveToNewGroupDown WithID l Window
l0 (Just Stack (Group l Window)
s) = forall (l :: * -> *).
WithID l Window
-> Stack (Group l Window)
-> (Group l Window
    -> Zipper (Group l Window) -> Zipper (Group l Window))
-> Zipper (Group l Window)
_moveToNewGroup WithID l Window
l0 Stack (Group l Window)
s forall a. a -> Zipper a -> Zipper a
insertDownZ


-- | Move the focused window to the previous group.
-- If 'True', when in the first group, wrap around to the last one.
-- If 'False', create a new group before it.
moveToGroupUp :: Bool -> ModifySpec
moveToGroupUp :: Bool -> ModifySpec
moveToGroupUp Bool
_ WithID l Window
_ Maybe (Stack (Group l Window))
Nothing = forall a. Maybe a
Nothing
moveToGroupUp Bool
False WithID l Window
l0 (Just Stack (Group l Window)
s) = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Stack a -> [a]
W.up Stack (Group l Window)
s) then ModifySpec
moveToNewGroupUp WithID l Window
l0 (forall a. a -> Maybe a
Just Stack (Group l Window)
s)
                                                   else Bool -> ModifySpec
moveToGroupUp Bool
True WithID l Window
l0 (forall a. a -> Maybe a
Just Stack (Group l Window)
s)
moveToGroupUp Bool
True WithID l Window
_ (Just s :: Stack (Group l Window)
s@(W.Stack Group l Window
_ [] [])) = forall a. a -> Maybe a
Just Stack (Group l Window)
s
moveToGroupUp Bool
True WithID l Window
_ (Just s :: Stack (Group l Window)
s@(W.Stack (G WithID l Window
l (Just Stack Window
f)) [Group l Window]
_ [Group l Window]
_))
    = let (Window
w, Maybe (Stack Window)
f') = forall a. Stack a -> (a, Zipper a)
_removeFocused Stack Window
f
      in forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ (forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper forall a b. (a -> b) -> a -> b
$ forall a. a -> Zipper a -> Zipper a
insertUpZ Window
w) forall a b. (a -> b) -> a -> b
$ forall a. Zipper a -> Zipper a
focusUpZ forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Stack (Group l Window)
s { focus :: Group l Window
W.focus = forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l Maybe (Stack Window)
f' }
moveToGroupUp Bool
True WithID l Window
_ Maybe (Stack (Group l Window))
gs = Maybe (Stack (Group l Window))
gs

-- | Move the focused window to the next group.
-- If 'True', when in the last group, wrap around to the first one.
-- If 'False', create a new group after it.
moveToGroupDown :: Bool -> ModifySpec
moveToGroupDown :: Bool -> ModifySpec
moveToGroupDown Bool
_ WithID l Window
_ Maybe (Stack (Group l Window))
Nothing = forall a. Maybe a
Nothing
moveToGroupDown Bool
False WithID l Window
l0 (Just Stack (Group l Window)
s) = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Stack a -> [a]
W.down Stack (Group l Window)
s) then ModifySpec
moveToNewGroupDown WithID l Window
l0 (forall a. a -> Maybe a
Just Stack (Group l Window)
s)
                                                       else Bool -> ModifySpec
moveToGroupDown Bool
True WithID l Window
l0 (forall a. a -> Maybe a
Just Stack (Group l Window)
s)
moveToGroupDown Bool
True WithID l Window
_ (Just s :: Stack (Group l Window)
s@(W.Stack Group l Window
_ [] [])) = forall a. a -> Maybe a
Just Stack (Group l Window)
s
moveToGroupDown Bool
True WithID l Window
_ (Just s :: Stack (Group l Window)
s@(W.Stack (G WithID l Window
l (Just Stack Window
f)) [Group l Window]
_ [Group l Window]
_))
    = let (Window
w, Maybe (Stack Window)
f') = forall a. Stack a -> (a, Zipper a)
_removeFocused Stack Window
f
      in forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ (forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper forall a b. (a -> b) -> a -> b
$ forall a. a -> Zipper a -> Zipper a
insertUpZ Window
w) forall a b. (a -> b) -> a -> b
$ forall a. Zipper a -> Zipper a
focusDownZ forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Stack (Group l Window)
s { focus :: Group l Window
W.focus = forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l Maybe (Stack Window)
f' }
moveToGroupDown Bool
True WithID l Window
_ Maybe (Stack (Group l Window))
gs = Maybe (Stack (Group l Window))
gs

-- | Split the focused group into two at the position of the focused window (below it,
-- unless it's the last window - in that case, above it).
splitGroup :: ModifySpec
splitGroup :: ModifySpec
splitGroup WithID l Window
_ Maybe (Stack (Group l Window))
Nothing = forall a. Maybe a
Nothing
splitGroup WithID l Window
l0 z :: Maybe (Stack (Group l Window))
z@(Just Stack (Group l Window)
s) | G WithID l Window
l (Just Stack Window
ws) <- forall a. Stack a -> a
W.focus Stack (Group l Window)
s
    = case Stack Window
ws of
        W.Stack Window
_ [] [] -> Maybe (Stack (Group l Window))
z
        W.Stack Window
f (Window
u:[Window]
up) [] -> let g1 :: Group l Window
g1 = forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l  forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
f [] []
                                   g2 :: Group l Window
g2 = forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l0 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
u [Window]
up []
                               in forall a. a -> Zipper a -> Zipper a
insertDownZ Group l Window
g1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ (forall a b. a -> b -> a
const Group l Window
g2) Maybe (Stack (Group l Window))
z
        W.Stack Window
f [Window]
up (Window
d:[Window]
down) -> let g1 :: Group l Window
g1 = forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l  forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
f [Window]
up []
                                     g2 :: Group l Window
g2 = forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l0 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
d [] [Window]
down
                                 in forall a. a -> Zipper a -> Zipper a
insertUpZ Group l Window
g1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ (forall a b. a -> b -> a
const Group l Window
g2) Maybe (Stack (Group l Window))
z
splitGroup WithID l Window
_ Maybe (Stack (Group l Window))
_ = forall a. Maybe a
Nothing