{-# 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 :: l Window -> l2 (Group l Window) -> Groups l l2 Window
group l Window
l l2 (Group l Window)
l2 = l Window
-> l2 (Group l Window)
-> Stack (Group l Window)
-> Uniq
-> Groups l l2 Window
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 = Maybe (Stack (Group l Window)) -> Stack (Group l Window)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Stack (Group l Window)) -> Stack (Group l Window))
-> Maybe (Stack (Group l Window)) -> Stack (Group l Window)
forall a b. (a -> b) -> a -> b
$ Group l Window -> Maybe (Stack (Group l Window))
forall a. a -> Zipper a
singletonZ (Group l Window -> Maybe (Stack (Group l Window)))
-> Group l Window -> Maybe (Stack (Group l Window))
forall a b. (a -> b) -> a -> b
$ WithID l Window -> Zipper Window -> Group l Window
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (Uniq -> l Window -> WithID l Window
forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID (Integer -> Integer -> Uniq
U Integer
0 Integer
0) l Window
l) Zipper Window
forall a. Zipper a
emptyZ

-- * Stuff with unique keys

data Uniq = U Integer Integer
  deriving (Uniq -> Uniq -> Bool
(Uniq -> Uniq -> Bool) -> (Uniq -> Uniq -> Bool) -> Eq Uniq
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
(Int -> Uniq -> ShowS)
-> (Uniq -> String) -> ([Uniq] -> ShowS) -> Show Uniq
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]
(Int -> ReadS Uniq)
-> ReadS [Uniq] -> ReadPrec Uniq -> ReadPrec [Uniq] -> Read 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, [Uniq])
gen :: Uniq -> (Uniq, [Uniq])
gen (U Integer
i1 Integer
i2) = (Integer -> Integer -> Uniq
U (Integer
i1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) Integer
i2, (Integer -> Uniq) -> [Integer] -> [Uniq]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Uniq
U Integer
i1) [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 { WithID l a -> Uniq
getID :: Uniq
                     , WithID l a -> l a
unID :: l a}
  deriving (Int -> WithID l a -> ShowS
[WithID l a] -> ShowS
WithID l a -> String
(Int -> WithID l a -> ShowS)
-> (WithID l a -> String)
-> ([WithID l a] -> ShowS)
-> Show (WithID l a)
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)
Int -> ReadS (WithID l a)
ReadS [WithID l a]
(Int -> ReadS (WithID l a))
-> ReadS [WithID l a]
-> ReadPrec (WithID l a)
-> ReadPrec [WithID l a]
-> Read (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 :: WithID l a -> WithID l a -> Bool
sameID (ID Uniq
id1 l a
_) (ID Uniq
id2 l a
_) = Uniq
id1 Uniq -> Uniq -> Bool
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 Uniq -> Uniq -> Bool
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') <- Workspace String (l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l a))
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
             ([(a, Rectangle)], Maybe (WithID l a))
-> X ([(a, Rectangle)], Maybe (WithID l a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
placements, Uniq -> l a -> WithID l a
forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id (l a -> WithID l a) -> Maybe (l a) -> Maybe (WithID l a)
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' <- l a -> SomeMessage -> X (Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
sm
                                    Maybe (WithID l a) -> X (Maybe (WithID l a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (WithID l a) -> X (Maybe (WithID l a)))
-> Maybe (WithID l a) -> X (Maybe (WithID l a))
forall a b. (a -> b) -> a -> b
$ Uniq -> l a -> WithID l a
forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id (l a -> WithID l a) -> Maybe (l a) -> Maybe (WithID l a)
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) = l a -> String
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 { Group l a -> WithID l a
gLayout :: WithID l a
                   , Group l a -> Zipper a
gZipper :: Zipper a }
  deriving (Int -> Group l a -> ShowS
[Group l a] -> ShowS
Group l a -> String
(Int -> Group l a -> ShowS)
-> (Group l a -> String)
-> ([Group l a] -> ShowS)
-> Show (Group l a)
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)
Int -> ReadS (Group l a)
ReadS [Group l a]
(Int -> ReadS (Group l a))
-> ReadS [Group l a]
-> ReadPrec (Group l a)
-> ReadPrec [Group l a]
-> Read (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
(Group l a -> Group l a -> Bool)
-> (Group l a -> Group l a -> Bool) -> Eq (Group l a)
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 :: (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 (WithID l a -> WithID l a) -> WithID l a -> WithID l a
forall a b. (a -> b) -> a -> b
$ Group l a -> WithID l a
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 :: (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 (Zipper a -> Zipper a) -> Zipper a -> Zipper a
forall a b. (a -> b) -> a -> b
$ Group l a -> Zipper a
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
                              Groups l l2 a -> l a
baseLayout :: l a
                              -- | The layout for placing each group on the screen
                            , Groups l l2 a -> l2 (Group l a)
partitioner :: l2 (Group l a)
                              -- | The window groups
                            , Groups l l2 a -> Stack (Group l a)
groups :: W.Stack (Group l a)
                              -- | A seed for generating unique ids
                            , 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 "String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
iString -> ShowS
forall 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 :: (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
id:[Uniq]
_) = Uniq -> (Uniq, [Uniq])
gen (Groups l l2 a -> Uniq
forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> Uniq
seed Groups l l2 a
g)
                       defaultGroups :: Stack (Group l a)
defaultGroups = Zipper (Group l a) -> Stack (Group l a)
forall a. HasCallStack => Maybe a -> a
fromJust (Zipper (Group l a) -> Stack (Group l a))
-> Zipper (Group l a) -> Stack (Group l a)
forall a b. (a -> b) -> a -> b
$ Group l a -> Zipper (Group l a)
forall a. a -> Zipper a
singletonZ (Group l a -> Zipper (Group l a))
-> Group l a -> Zipper (Group l a)
forall a b. (a -> b) -> a -> b
$ WithID l a -> Zipper a -> Group l a
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (Uniq -> l a -> WithID l a
forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id (l a -> WithID l a) -> l a -> WithID l a
forall a b. (a -> b) -> a -> b
$ Groups l l2 a -> l a
forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 a
g) Zipper a
forall a. Zipper a
emptyZ
                   in Groups l l2 a
g { groups :: Stack (Group l a)
groups = Stack (Group l a) -> Zipper (Group l a) -> Stack (Group l a)
forall a. a -> Maybe a -> a
fromMaybe Stack (Group l a)
defaultGroups (Zipper (Group l a) -> Stack (Group l a))
-> (Stack (Group l a) -> Zipper (Group l a))
-> Stack (Group l a)
-> Stack (Group l a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper (Group l a) -> Zipper (Group l a)
f (Zipper (Group l a) -> Zipper (Group l a))
-> (Stack (Group l a) -> Zipper (Group l a))
-> Stack (Group l a)
-> Zipper (Group l a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Group l a) -> Zipper (Group l a)
forall a. a -> Maybe a
Just (Stack (Group l a) -> Stack (Group l a))
-> Stack (Group l a) -> Stack (Group l a)
forall a b. (a -> b) -> a -> b
$ Groups l l2 a -> Stack (Group l a)
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 :: (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
id:[Uniq]
_) = Uniq -> (Uniq, [Uniq])
gen (Groups l l2 a -> Uniq
forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> Uniq
seed Groups l l2 a
g)
      defaultGroups :: Stack (Group l a)
defaultGroups = Zipper (Group l a) -> Stack (Group l a)
forall a. HasCallStack => Maybe a -> a
fromJust (Zipper (Group l a) -> Stack (Group l a))
-> Zipper (Group l a) -> Stack (Group l a)
forall a b. (a -> b) -> a -> b
$ Group l a -> Zipper (Group l a)
forall a. a -> Zipper a
singletonZ (Group l a -> Zipper (Group l a))
-> Group l a -> Zipper (Group l a)
forall a b. (a -> b) -> a -> b
$ WithID l a -> Zipper a -> Group l a
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (Uniq -> l a -> WithID l a
forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id (l a -> WithID l a) -> l a -> WithID l a
forall a b. (a -> b) -> a -> b
$ Groups l l2 a -> l a
forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 a
g) Zipper a
forall a. Zipper a
emptyZ
  Zipper (Group l a)
g' <- Zipper (Group l a) -> X (Zipper (Group l a))
f (Zipper (Group l a) -> X (Zipper (Group l a)))
-> (Stack (Group l a) -> Zipper (Group l a))
-> Stack (Group l a)
-> X (Zipper (Group l a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Group l a) -> Zipper (Group l a)
forall a. a -> Maybe a
Just (Stack (Group l a) -> X (Zipper (Group l a)))
-> Stack (Group l a) -> X (Zipper (Group l a))
forall a b. (a -> b) -> a -> b
$ Groups l l2 a -> Stack (Group l a)
forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 a
g
  Groups l l2 a -> X (Groups l l2 a)
forall (m :: * -> *) a. Monad m => a -> m a
return Groups l l2 a
g { groups :: Stack (Group l a)
groups = Stack (Group l a) -> Zipper (Group l a) -> Stack (Group l a)
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 :: Zipper a -> Groups l l2 a -> Groups l l2 a
readapt Zipper a
z Groups l l2 a
g = let mf :: Maybe a
mf = Zipper a -> Maybe a
forall a. Zipper a -> Maybe a
getFocusZ Zipper a
z
                  (Uniq
seed', Uniq
id:[Uniq]
_) = Uniq -> (Uniq, [Uniq])
gen (Uniq -> (Uniq, [Uniq])) -> Uniq -> (Uniq, [Uniq])
forall a b. (a -> b) -> a -> b
$ Groups l l2 a -> Uniq
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 ((Zipper (Group l a) -> Zipper (Group l a))
 -> Groups l l2 a -> Groups l l2 a)
-> Groups l l2 a
-> (Zipper (Group l a) -> Zipper (Group l a))
-> Groups l l2 a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Zipper (Group l a) -> Zipper (Group l a))
-> Groups l l2 a -> Groups l l2 a
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' ((Zipper (Group l a) -> Zipper (Group l a)) -> Groups l l2 a)
-> (Zipper (Group l a) -> Zipper (Group l a)) -> Groups l l2 a
forall a b. (a -> b) -> a -> b
$ (Group l a -> Group l a)
-> Zipper (Group l a) -> Zipper (Group l a)
forall a b. (a -> b) -> Zipper a -> Zipper b
mapZ_ ((Zipper a -> Zipper a) -> Group l a -> Group l a
forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper ((Zipper a -> Zipper a) -> Group l a -> Group l a)
-> (Zipper a -> Zipper a) -> Group l a -> Group l a
forall a b. (a -> b) -> a -> b
$ Zipper a -> Zipper a -> Zipper a
forall a. Eq a => Zipper a -> Zipper a -> Zipper a
removeDeleted Zipper a
z)
                                        (Zipper (Group l a) -> Zipper (Group l a))
-> (Zipper (Group l a) -> Zipper (Group l a))
-> Zipper (Group l a)
-> Zipper (Group l a)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Group l a -> Bool) -> Zipper (Group l a) -> Zipper (Group l a)
forall a. (a -> Bool) -> Maybe (Stack a) -> Maybe (Stack a)
filterKeepLast (Zipper a -> Bool
forall a. Maybe a -> Bool
isJust (Zipper a -> Bool) -> (Group l a -> Zipper a) -> Group l a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group l a -> Zipper a
forall (l :: * -> *) a. Group l a -> Zipper a
gZipper)
                                        (Zipper (Group l a) -> Zipper (Group l a))
-> (Zipper (Group l a) -> Zipper (Group l a))
-> Zipper (Group l a)
-> Zipper (Group l a)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [a] -> Zipper (Group l a) -> (Zipper (Group l a), [a])
forall a (l :: * -> *).
Eq a =>
[a] -> Zipper (Group l a) -> (Zipper (Group l a), [a])
findNewWindows (Zipper a -> [a]
forall a. Maybe (Stack a) -> [a]
W.integrate' Zipper a
z)
                                        (Zipper (Group l a) -> (Zipper (Group l a), [a]))
-> ((Zipper (Group l a), [a]) -> Zipper (Group l a))
-> Zipper (Group l a)
-> Zipper (Group l a)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> WithID l a -> (Zipper (Group l a), [a]) -> Zipper (Group l a)
forall (l :: * -> *) a.
WithID l a -> (Zipper (Group l a), [a]) -> Zipper (Group l a)
addWindows (Uniq -> l a -> WithID l a
forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id (l a -> WithID l a) -> l a -> WithID l a
forall a b. (a -> b) -> a -> b
$ Groups l l2 a -> l a
forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 a
g)
                                        ((Zipper (Group l a), [a]) -> Zipper (Group l a))
-> (Zipper (Group l a) -> Zipper (Group l a))
-> (Zipper (Group l a), [a])
-> Zipper (Group l a)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Maybe a -> Zipper (Group l a) -> Zipper (Group l a)
forall a (l :: * -> *).
Eq a =>
Maybe a -> Zipper (Group l a) -> Zipper (Group l a)
focusGroup Maybe a
mf
                                        (Zipper (Group l a) -> Zipper (Group l a))
-> (Zipper (Group l a) -> Zipper (Group l a))
-> Zipper (Group l a)
-> Zipper (Group l a)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Group l a -> Group l a)
-> Zipper (Group l a) -> Zipper (Group l a)
forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ ((Zipper a -> Zipper a) -> Group l a -> Group l a
forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper ((Zipper a -> Zipper a) -> Group l a -> Group l a)
-> (Zipper a -> Zipper a) -> Group l a -> Group l a
forall a b. (a -> b) -> a -> b
$ Maybe a -> Zipper a -> Zipper a
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 = Maybe (Stack a)
forall a. Maybe a
Nothing
          filterKeepLast a -> Bool
f z :: Maybe (Stack a)
z@(Just Stack a
s) =  (a -> Bool) -> Maybe (Stack a) -> Maybe (Stack a)
forall a. (a -> Bool) -> Maybe (Stack a) -> Maybe (Stack a)
filterZ_ a -> Bool
f Maybe (Stack a)
z
                                     Maybe (Stack a) -> Maybe (Stack a) -> Maybe (Stack a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Maybe (Stack a)
forall a. a -> Zipper a
singletonZ (Stack a -> a
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 :: Zipper a -> Zipper a -> Zipper a
removeDeleted Zipper a
z = (a -> Bool) -> Zipper a -> Zipper a
forall a. (a -> Bool) -> Maybe (Stack a) -> Maybe (Stack a)
filterZ_ (a -> Zipper a -> Bool
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 :: [a] -> Zipper (Group l a) -> (Zipper (Group l a), [a])
findNewWindows [a]
as Zipper (Group l a)
gs = (Zipper (Group l a)
gs, (Group l a -> [a] -> [a]) -> [a] -> Zipper (Group l a) -> [a]
forall a b. (a -> b -> b) -> b -> Zipper a -> b
foldrZ_ Group l a -> [a] -> [a]
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 [a]
as' = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Zipper a -> Bool) -> Zipper a -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Zipper a -> Bool
forall a. Eq a => a -> Zipper a -> Bool
elemZ (Group l a -> Zipper a
forall (l :: * -> *) a. Group l a -> Zipper a
gZipper Group l a
g)) [a]
as'

-- | 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 :: WithID l a -> (Zipper (Group l a), [a]) -> Zipper (Group l a)
addWindows WithID l a
l (Zipper (Group l a)
Nothing, [a]
as) = Group l a -> Zipper (Group l a)
forall a. a -> Zipper a
singletonZ (Group l a -> Zipper (Group l a))
-> Group l a -> Zipper (Group l a)
forall a b. (a -> b) -> a -> b
$ WithID l a -> Zipper a -> Group l a
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l a
l ([a] -> Zipper a
forall a. [a] -> Maybe (Stack a)
W.differentiate [a]
as)
addWindows WithID l a
_ (Zipper (Group l a)
z, [a]
as) = (Group l a -> Group l a)
-> Zipper (Group l a) -> Zipper (Group l a)
forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ ((Zipper a -> Zipper a) -> Group l a -> Group l a
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 = (Zipper a -> a -> Zipper a) -> Zipper a -> [a] -> Zipper a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> Zipper a -> Zipper a) -> Zipper a -> a -> Zipper a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Zipper a -> Zipper a
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 :: Maybe a -> Zipper (Group l a) -> Zipper (Group l a)
focusGroup Maybe a
Nothing = Zipper (Group l a) -> Zipper (Group l a)
forall a. a -> a
id
focusGroup (Just a
a) = [Either (Group l a) (Group l a)] -> Zipper (Group l a)
forall a. [Either a a] -> Zipper a
fromTags ([Either (Group l a) (Group l a)] -> Zipper (Group l a))
-> (Zipper (Group l a) -> [Either (Group l a) (Group l a)])
-> Zipper (Group l a)
-> Zipper (Group l a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Group l a -> Either (Group l a) (Group l a))
-> [Group l a] -> [Either (Group l a) (Group l a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Group l a -> Bool) -> Group l a -> Either (Group l a) (Group l a)
forall a. (a -> Bool) -> a -> Either a a
tagBy ((Group l a -> Bool)
 -> Group l a -> Either (Group l a) (Group l a))
-> (Group l a -> Bool)
-> Group l a
-> Either (Group l a) (Group l a)
forall a b. (a -> b) -> a -> b
$ a -> Zipper a -> Bool
forall a. Eq a => a -> Zipper a -> Bool
elemZ a
a (Zipper a -> Bool) -> (Group l a -> Zipper a) -> Group l a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group l a -> Zipper a
forall (l :: * -> *) a. Group l a -> Zipper a
gZipper) ([Group l a] -> [Either (Group l a) (Group l a)])
-> (Zipper (Group l a) -> [Group l a])
-> Zipper (Group l a)
-> [Either (Group l a) (Group l a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper (Group l a) -> [Group l a]
forall a. Maybe (Stack a) -> [a]
W.integrate'

-- | Focus the given window
focusWindow :: Eq a => Maybe a -> Zipper a -> Zipper a
focusWindow :: Maybe a -> Zipper a -> Zipper a
focusWindow Maybe a
Nothing = Zipper a -> Zipper a
forall a. a -> a
id
focusWindow (Just a
a) = [Either a a] -> Zipper a
forall a. [Either a a] -> Zipper a
fromTags ([Either a a] -> Zipper a)
-> (Zipper a -> [Either a a]) -> Zipper a -> Zipper a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either a a) -> [a] -> [Either a a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Bool) -> a -> Either a a
forall a. (a -> Bool) -> a -> Either a a
tagBy (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
a)) ([a] -> [Either a a])
-> (Zipper a -> [a]) -> Zipper a -> [Either a a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper a -> [a]
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
s1String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" by "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
s2
            where s1 :: String
s1 = WithID l Window -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description (WithID l Window -> String) -> WithID l Window -> String
forall a b. (a -> b) -> a -> b
$ Group l Window -> WithID l Window
forall (l :: * -> *) a. Group l a -> WithID l a
gLayout (Group l Window -> WithID l Window)
-> Group l Window -> WithID l Window
forall a b. (a -> b) -> a -> b
$ Stack (Group l Window) -> Group l Window
forall a. Stack a -> a
W.focus Stack (Group l Window)
gs
                  s2 :: String
s2 = l2 (Group l Window) -> String
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 Zipper Window
z) Rectangle
r = let l :: Groups l l2 Window
l = Zipper Window -> Groups l l2 Window -> Groups l l2 Window
forall a (l :: * -> *) (l2 :: * -> *).
Eq a =>
Zipper a -> Groups l l2 a -> Groups l l2 a
readapt Zipper Window
z Groups l l2 Window
_l in
            do ([(Group l Window, Rectangle)]
areas, Maybe (l2 (Group l Window))
mpart') <- Workspace String (l2 (Group l Window)) (Group l Window)
-> Rectangle
-> X ([(Group l Window, Rectangle)], Maybe (l2 (Group l Window)))
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 = Groups l l2 Window -> l2 (Group l Window)
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 = Stack (Group l Window) -> Maybe (Stack (Group l Window))
forall a. a -> Maybe a
Just (Stack (Group l Window) -> Maybe (Stack (Group l Window)))
-> Stack (Group l Window) -> Maybe (Stack (Group l Window))
forall a b. (a -> b) -> a -> b
$ Groups l l2 Window -> Stack (Group l Window)
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 <- [(Group l Window, Rectangle)]
-> ((Group l Window, Rectangle)
    -> X ([(Window, Rectangle)], Maybe (WithID l Window)))
-> X [([(Window, Rectangle)], Maybe (WithID l Window))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Group l Window, Rectangle)]
areas (((Group l Window, Rectangle)
  -> X ([(Window, Rectangle)], Maybe (WithID l Window)))
 -> X [([(Window, Rectangle)], Maybe (WithID l Window))])
-> ((Group l Window, Rectangle)
    -> X ([(Window, Rectangle)], Maybe (WithID l Window)))
-> X [([(Window, Rectangle)], Maybe (WithID l Window))]
forall a b. (a -> b) -> a -> b
$ \(Group l Window
g, Rectangle
r') -> Workspace String (WithID l Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (WithID l Window))
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 = Group l Window -> WithID l Window
forall (l :: * -> *) a. Group l a -> WithID l a
gLayout Group l Window
g
                                                                , stack :: Zipper Window
W.stack = Group l Window -> Zipper Window
forall (l :: * -> *) a. Group l a -> Zipper a
gZipper Group l Window
g } Rectangle
r'

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

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

               ([(Window, Rectangle)], Maybe (Groups l l2 Window))
-> X ([(Window, Rectangle)], Maybe (Groups l l2 Window))
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') <- SomeMessage -> Maybe GroupsMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm
            = do Maybe (l2 (Group l Window))
mp' <- l2 (Group l Window)
-> SomeMessage -> X (Maybe (l2 (Group l Window)))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 (Group l Window)
p SomeMessage
sm'
                 Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window)))
-> Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall a b. (a -> b) -> a -> b
$ Groups l l2 Window
-> Maybe (l2 (Group l Window))
-> [Maybe (WithID l Window)]
-> Maybe (Groups l l2 Window)
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') <- SomeMessage -> Maybe GroupsMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm
            = do Maybe (l2 (Group l Window))
mp' <- l2 (Group l Window)
-> SomeMessage -> X (Maybe (l2 (Group l Window)))
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 <- (Group l Window -> X (Maybe (WithID l Window)))
-> Maybe (Stack (Group l Window))
-> X (Zipper (Maybe (WithID l Window)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Zipper a -> m (Zipper b)
mapZM_ (SomeMessage -> Group l Window -> X (Maybe (WithID l Window))
forall (l :: * -> *) a.
LayoutClass l a =>
SomeMessage -> Group l a -> X (Maybe (WithID l a))
handle SomeMessage
sm') (Maybe (Stack (Group l Window))
 -> X (Zipper (Maybe (WithID l Window))))
-> Maybe (Stack (Group l Window))
-> X (Zipper (Maybe (WithID l Window)))
forall a b. (a -> b) -> a -> b
$ Stack (Group l Window) -> Maybe (Stack (Group l Window))
forall a. a -> Maybe a
Just Stack (Group l Window)
gs
                 Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window)))
-> Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall a b. (a -> b) -> a -> b
$ Groups l l2 Window
-> Maybe (l2 (Group l Window))
-> [Maybe (WithID l Window)]
-> Maybe (Groups l l2 Window)
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' ([Maybe (WithID l Window)] -> Maybe (Groups l l2 Window))
-> [Maybe (WithID l Window)] -> Maybe (Groups l l2 Window)
forall a b. (a -> b) -> a -> b
$ Zipper (Maybe (WithID l Window)) -> [Maybe (WithID l Window)]
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
_) = WithID l a -> SomeMessage -> X (Maybe (WithID l 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 <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm
            = let _rightType :: Bool
_rightType = LayoutMessages
a LayoutMessages -> LayoutMessages -> Bool
forall a. Eq a => a -> a -> Bool
== LayoutMessages
Hide -- Is there a better-looking way
                                         -- of doing this?
              in Groups l l2 Window -> SomeMessage -> X (Maybe (Groups l l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Groups l l2 Window
l (SomeMessage -> X (Maybe (Groups l l2 Window)))
-> SomeMessage -> X (Maybe (Groups l l2 Window))
forall a b. (a -> b) -> a -> b
$ GroupsMessage -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage (GroupsMessage -> SomeMessage) -> GroupsMessage -> 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 SomeMessage -> Maybe GroupsMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm of
              Just (ToFocused SomeMessage
sm') -> do [Maybe (WithID l Window)]
mg's <- Zipper (Maybe (WithID l Window)) -> [Maybe (WithID l Window)]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Zipper (Maybe (WithID l Window)) -> [Maybe (WithID l Window)])
-> X (Zipper (Maybe (WithID l Window)))
-> X [Maybe (WithID l Window)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeMessage
-> Stack (Group l Window) -> X (Zipper (Maybe (WithID l Window)))
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
                                         Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window)))
-> Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall a b. (a -> b) -> a -> b
$ Groups l l2 Window
-> Maybe (l2 (Group l Window))
-> [Maybe (WithID l Window)]
-> Maybe (Groups l l2 Window)
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))
forall a. Maybe a
Nothing [Maybe (WithID l Window)]
mg's
              Just (ToGroup Int
i SomeMessage
sm') -> do [Maybe (WithID l Window)]
mg's <- Int
-> SomeMessage
-> Stack (Group l Window)
-> X [Maybe (WithID l Window)]
forall (l :: * -> *) a a.
(LayoutClass l a, Num a, Enum a, Eq a) =>
a -> SomeMessage -> Stack (Group l a) -> X [Maybe (WithID l a)]
handleOnIndex Int
i SomeMessage
sm' Stack (Group l Window)
z
                                         Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window)))
-> Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall a b. (a -> b) -> a -> b
$ Groups l l2 Window
-> Maybe (l2 (Group l Window))
-> [Maybe (WithID l Window)]
-> Maybe (Groups l l2 Window)
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))
forall a. Maybe a
Nothing [Maybe (WithID l Window)]
mg's
              Just (Modify ModifySpec
spec) -> case ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
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' -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
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 -> Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Groups l l2 Window)
forall a. Maybe a
Nothing
              Just (ModifyX ModifySpecX
spec) -> do Maybe (Groups l l2 Window)
ml' <- ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
forall (l :: * -> *) (l2 :: * -> *).
ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
applySpecX ModifySpecX
spec Groups l l2 Window
l
                                        Maybe (Groups l l2 Window) -> (Groups l l2 Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Groups l l2 Window)
ml' (X (Maybe (Groups l l2 Window)) -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X (Maybe (Groups l l2 Window)) -> X ())
-> (Groups l l2 Window -> X (Maybe (Groups l l2 Window)))
-> Groups l l2 Window
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Groups l l2 Window -> X (Maybe (Groups l l2 Window))
forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus)
                                        Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Groups l l2 Window)
ml' Maybe (Groups l l2 Window)
-> Maybe (Groups l l2 Window) -> Maybe (Groups l l2 Window)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Groups l l2 Window -> Maybe (Groups l l2 Window)
forall a. a -> Maybe a
Just Groups l l2 Window
l)
              Just GroupsMessage
Refocus -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus Groups l l2 Window
l
              Just GroupsMessage
_ -> Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Groups l l2 Window)
forall a. Maybe a
Nothing
              Maybe GroupsMessage
Nothing -> Groups l l2 Window -> SomeMessage -> X (Maybe (Groups l l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage Groups l l2 Window
l (SomeMessage -> X (Maybe (Groups l l2 Window)))
-> SomeMessage -> X (Maybe (Groups l l2 Window))
forall a b. (a -> b) -> a -> b
$ GroupsMessage -> SomeMessage
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 = (Bool -> Group l a -> X (Maybe (WithID l a)))
-> Zipper (Group l a) -> X (Zipper (Maybe (WithID l a)))
forall (m :: * -> *) a b.
Monad m =>
(Bool -> a -> m b) -> Zipper a -> m (Zipper b)
mapZM Bool -> Group l a -> X (Maybe (WithID l a))
forall (l :: * -> *) a.
LayoutClass l a =>
Bool -> Group l a -> X (Maybe (WithID l a))
step (Zipper (Group l a) -> X (Zipper (Maybe (WithID l a))))
-> Zipper (Group l a) -> X (Zipper (Maybe (WithID l a)))
forall a b. (a -> b) -> a -> b
$ Stack (Group l a) -> Zipper (Group l a)
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
_) = WithID l a -> SomeMessage -> X (Maybe (WithID l 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
_ = Maybe (WithID l a) -> X (Maybe (WithID l a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (WithID l a)
forall a. Maybe a
Nothing
                  handleOnIndex :: a -> SomeMessage -> Stack (Group l a) -> X [Maybe (WithID l a)]
handleOnIndex a
i SomeMessage
sm Stack (Group l a)
z = ((a, Group l a) -> X (Maybe (WithID l a)))
-> [(a, Group l a)] -> X [Maybe (WithID l a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (a, Group l a) -> X (Maybe (WithID l a))
forall (l :: * -> *) a.
LayoutClass l a =>
(a, Group l a) -> X (Maybe (WithID l a))
step ([(a, Group l a)] -> X [Maybe (WithID l a)])
-> [(a, Group l a)] -> X [Maybe (WithID l a)]
forall a b. (a -> b) -> a -> b
$ [a] -> [Group l a] -> [(a, Group l a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
0..] ([Group l a] -> [(a, Group l a)])
-> [Group l a] -> [(a, Group l a)]
forall a b. (a -> b) -> a -> b
$ Stack (Group l a) -> [Group l a]
forall a. Stack a -> [a]
W.integrate Stack (Group l a)
z
                      where step :: (a, Group l a) -> X (Maybe (WithID l a))
step (a
j, G WithID l a
l Zipper a
_) | a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
j = WithID l a -> SomeMessage -> X (Maybe (WithID l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage WithID l a
l SomeMessage
sm
                            step (a, Group l a)
_ = Maybe (WithID l a) -> X (Maybe (WithID l a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (WithID l a)
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 :: 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 = Groups l l2 a -> Maybe (Groups l l2 a)
forall a. a -> Maybe a
Just Groups l l2 a
g { partitioner :: l2 (Group l a)
partitioner = l2 (Group l a) -> Maybe (l2 (Group l a)) -> l2 (Group l a)
forall a. a -> Maybe a -> a
fromMaybe (Groups l l2 a -> l2 (Group l a)
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 = Stack (Group l a) -> [Maybe (WithID l a)] -> Stack (Group l a)
forall (l :: * -> *) a.
Stack (Group l a) -> [Maybe (WithID l a)] -> Stack (Group l a)
combine (Groups l l2 a -> Stack (Group l a)
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 = (WithID l a -> (Uniq, l a)) -> [WithID l a] -> [(Uniq, l a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ID Uniq
id l a
a) -> (Uniq
id, l a
a)) ([WithID l a] -> [(Uniq, l a)]) -> [WithID l a] -> [(Uniq, l a)]
forall a b. (a -> b) -> a -> b
$ [Maybe (WithID l a)] -> [WithID l a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (WithID l a)]
ml's
                           in ((Group l a -> Group l a)
 -> Stack (Group l a) -> Stack (Group l a))
-> Stack (Group l a)
-> (Group l a -> Group l a)
-> Stack (Group l a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Group l a -> Group l a) -> Stack (Group l a) -> Stack (Group l a)
forall a b. (a -> b) -> Stack a -> Stack b
mapS_ Stack (Group l a)
z ((Group l a -> Group l a) -> Stack (Group l a))
-> (Group l a -> Group l a) -> Stack (Group l a)
forall a b. (a -> b) -> a -> b
$ \(G (ID Uniq
id l a
l) Zipper a
ws) -> case Uniq -> [(Uniq, l a)] -> Maybe (l a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Uniq
id [(Uniq, l a)]
table of
                                        Maybe (l a)
Nothing -> WithID l a -> Zipper a -> Group l a
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (Uniq -> l a -> WithID l a
forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id l a
l) Zipper a
ws
                                        Just l a
l' -> WithID l a -> Zipper a -> Group l a
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (Uniq -> l a -> WithID l a
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 = Maybe (Stack b) -> Stack b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Stack b) -> Stack b)
-> (Stack a -> Maybe (Stack b)) -> Stack a -> Stack b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Zipper a -> Maybe (Stack b)
forall a b. (a -> b) -> Zipper a -> Zipper b
mapZ_ a -> b
f (Zipper a -> Maybe (Stack b))
-> (Stack a -> Zipper a) -> Stack a -> Maybe (Stack b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> Zipper a
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 :: 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 | (Maybe (WithID l a) -> Bool) -> [Maybe (WithID l a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe (WithID l a) -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe (WithID l a)]
ml's = Maybe (Groups l l2 a)
forall a. Maybe a
Nothing
maybeMakeNew Groups l l2 a
g Maybe (l2 (Group l a))
mpart' [Maybe (WithID l a)]
ml's = Groups l l2 a
-> Maybe (l2 (Group l a))
-> [Maybe (WithID l a)]
-> Maybe (Groups l l2 a)
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 :: Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus Groups l l2 Window
g =
  let mw :: Maybe Window
mw = (Zipper Window -> Maybe Window
forall a. Zipper a -> Maybe a
getFocusZ (Zipper Window -> Maybe Window)
-> (Groups l l2 Window -> Zipper Window)
-> Groups l l2 Window
-> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group l Window -> Zipper Window
forall (l :: * -> *) a. Group l a -> Zipper a
gZipper (Group l Window -> Zipper Window)
-> (Groups l l2 Window -> Group l Window)
-> Groups l l2 Window
-> Zipper Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Group l Window) -> Group l Window
forall a. Stack a -> a
W.focus (Stack (Group l Window) -> Group l Window)
-> (Groups l l2 Window -> Stack (Group l Window))
-> Groups l l2 Window
-> Group l Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Groups l l2 Window -> Stack (Group l Window)
forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups) Groups l l2 Window
g
  in  Groups l l2 Window
g Groups l l2 Window -> Maybe Window -> Maybe (Groups l l2 Window)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe Window
mw Maybe (Groups l l2 Window)
-> X () -> X (Maybe (Groups l l2 Window))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Window
mw ((WindowSet -> WindowSet) -> X ()
modifyWindowSet ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
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 :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
applySpec ModifySpec
f Groups l l2 Window
g =
    let (Uniq
seed', Uniq
id:[Uniq]
ids) =  Uniq -> (Uniq, [Uniq])
gen (Uniq -> (Uniq, [Uniq])) -> Uniq -> (Uniq, [Uniq])
forall a b. (a -> b) -> a -> b
$ Groups l l2 Window -> Uniq
forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> Uniq
seed Groups l l2 Window
g
        g' :: Groups l l2 Window
g' = ((Zipper (Group l Window) -> Zipper (Group l Window))
 -> Groups l l2 Window -> Groups l l2 Window)
-> Groups l l2 Window
-> (Zipper (Group l Window) -> Zipper (Group l Window))
-> Groups l l2 Window
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Zipper (Group l Window) -> Zipper (Group l Window))
-> Groups l l2 Window -> Groups l l2 Window
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 ((Zipper (Group l Window) -> Zipper (Group l Window))
 -> Groups l l2 Window)
-> (Zipper (Group l Window) -> Zipper (Group l Window))
-> Groups l l2 Window
forall a b. (a -> b) -> a -> b
$ WithID l Window
-> Zipper (Group l Window) -> Zipper (Group l Window)
ModifySpec
f (Uniq -> l Window -> WithID l Window
forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id (l Window -> WithID l Window) -> l Window -> WithID l Window
forall a b. (a -> b) -> a -> b
$ Groups l l2 Window -> l Window
forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 Window
g)
                                   (Zipper (Group l Window) -> Zipper (Group l Window))
-> (Zipper (Group l Window) -> Zipper (Group l Window))
-> Zipper (Group l Window)
-> Zipper (Group l Window)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Zipper (Group l Window)
-> [Either (Group l Window) (Group l Window)]
forall a. Zipper a -> [Either a a]
toTags
                                   (Zipper (Group l Window)
 -> [Either (Group l Window) (Group l Window)])
-> ([Either (Group l Window) (Group l Window)]
    -> Zipper (Group l Window))
-> Zipper (Group l Window)
-> Zipper (Group l Window)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either (Group l Window) (Group l Window)
 -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
 -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)]))
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> [Either (Group l Window) (Group l Window)]
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Groups l l2 Window
-> Either (Group l Window) (Group l Window)
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window
-> Either (Group l Window) (Group l Window)
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
reID Groups l l2 Window
g) (([Uniq]
ids, []), [])
                                   ([Either (Group l Window) (Group l Window)]
 -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)]))
-> ((([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
    -> Zipper (Group l Window))
-> [Either (Group l Window) (Group l Window)]
-> Zipper (Group l Window)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> [Either (Group l Window) (Group l Window)]
forall a b. (a, b) -> b
snd
                                   ((([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
 -> [Either (Group l Window) (Group l Window)])
-> ([Either (Group l Window) (Group l Window)]
    -> Zipper (Group l Window))
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> Zipper (Group l Window)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Either (Group l Window) (Group l Window)]
-> Zipper (Group l Window)
forall a. [Either a a] -> Zipper a
fromTags
    in if Groups l l2 Window -> Stack (Group l Window)
forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 Window
g Stack (Group l Window) -> Stack (Group l Window) -> Bool
forall a. Eq a => a -> a -> Bool
== Groups l l2 Window -> Stack (Group l Window)
forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 Window
g'
       then Maybe (Groups l l2 Window)
forall a. Maybe a
Nothing
       else Groups l l2 Window -> Maybe (Groups l l2 Window)
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 :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
applySpecX ModifySpecX
f Groups l l2 Window
g = do
    let (Uniq
seed', Uniq
id:[Uniq]
ids) = Uniq -> (Uniq, [Uniq])
gen (Uniq -> (Uniq, [Uniq])) -> Uniq -> (Uniq, [Uniq])
forall a b. (a -> b) -> a -> b
$ Groups l l2 Window -> Uniq
forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> Uniq
seed Groups l l2 Window
g
    Groups l l2 Window
g' <- ((Zipper (Group l Window) -> X (Zipper (Group l Window)))
 -> Groups l l2 Window -> X (Groups l l2 Window))
-> Groups l l2 Window
-> (Zipper (Group l Window) -> X (Zipper (Group l Window)))
-> X (Groups l l2 Window)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Zipper (Group l Window) -> X (Zipper (Group l Window)))
-> Groups l l2 Window -> X (Groups l l2 Window)
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 ((Zipper (Group l Window) -> X (Zipper (Group l Window)))
 -> X (Groups l l2 Window))
-> (Zipper (Group l Window) -> X (Zipper (Group l Window)))
-> X (Groups l l2 Window)
forall a b. (a -> b) -> a -> b
$ WithID l Window
-> Zipper (Group l Window) -> X (Zipper (Group l Window))
ModifySpecX
f (Uniq -> l Window -> WithID l Window
forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id (l Window -> WithID l Window) -> l Window -> WithID l Window
forall a b. (a -> b) -> a -> b
$ Groups l l2 Window -> l Window
forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 Window
g)
                                (Zipper (Group l Window) -> X (Zipper (Group l Window)))
-> (X (Zipper (Group l Window)) -> X (Zipper (Group l Window)))
-> Zipper (Group l Window)
-> X (Zipper (Group l Window))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Zipper (Group l Window)
 -> [Either (Group l Window) (Group l Window)])
-> X (Zipper (Group l Window))
-> X [Either (Group l Window) (Group l Window)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Zipper (Group l Window)
-> [Either (Group l Window) (Group l Window)]
forall a. Zipper a -> [Either a a]
toTags
                                (X (Zipper (Group l Window))
 -> X [Either (Group l Window) (Group l Window)])
-> (X [Either (Group l Window) (Group l Window)]
    -> X (Zipper (Group l Window)))
-> X (Zipper (Group l Window))
-> X (Zipper (Group l Window))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Either (Group l Window) (Group l Window)]
 -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)]))
-> X [Either (Group l Window) (Group l Window)]
-> X (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either (Group l Window) (Group l Window)
 -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
 -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)]))
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> [Either (Group l Window) (Group l Window)]
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Groups l l2 Window
-> Either (Group l Window) (Group l Window)
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
forall (l :: * -> *) (l2 :: * -> *).
Groups l l2 Window
-> Either (Group l Window) (Group l Window)
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
reID Groups l l2 Window
g) (([Uniq]
ids, []), []))
                                (X [Either (Group l Window) (Group l Window)]
 -> X (([Uniq], [Uniq]),
       [Either (Group l Window) (Group l Window)]))
-> (X (([Uniq], [Uniq]),
       [Either (Group l Window) (Group l Window)])
    -> X (Zipper (Group l Window)))
-> X [Either (Group l Window) (Group l Window)]
-> X (Zipper (Group l Window))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
 -> [Either (Group l Window) (Group l Window)])
-> X (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> X [Either (Group l Window) (Group l Window)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> [Either (Group l Window) (Group l Window)]
forall a b. (a, b) -> b
snd
                                (X (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
 -> X [Either (Group l Window) (Group l Window)])
-> (X [Either (Group l Window) (Group l Window)]
    -> X (Zipper (Group l Window)))
-> X (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> X (Zipper (Group l Window))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Either (Group l Window) (Group l Window)]
 -> Zipper (Group l Window))
-> X [Either (Group l Window) (Group l Window)]
-> X (Zipper (Group l Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Group l Window) (Group l Window)]
-> Zipper (Group l Window)
forall a. [Either a a] -> Zipper a
fromTags
    Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window)))
-> Maybe (Groups l l2 Window) -> X (Maybe (Groups l l2 Window))
forall a b. (a -> b) -> a -> b
$ if Groups l l2 Window -> Stack (Group l Window)
forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 Window
g Stack (Group l Window) -> Stack (Group l Window) -> Bool
forall a. Eq a => a -> a -> Bool
== Groups l l2 Window -> Stack (Group l Window)
forall (l :: * -> *) (l2 :: * -> *) a.
Groups l l2 a -> Stack (Group l a)
groups Groups l l2 Window
g'
             then Maybe (Groups l l2 Window)
forall a. Maybe a
Nothing
             else Groups l l2 Window -> Maybe (Groups l l2 Window)
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)
     -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
     -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
reID :: Groups l l2 Window
-> Either (Group l Window) (Group l Window)
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
reID Groups l l2 Window
_ Either (Group l Window) (Group l Window)
_ (([], [Uniq]
_), [Either (Group l Window) (Group l Window)]
_) = (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
forall a. HasCallStack => a
undefined -- The list of ids is infinite
reID Groups l l2 Window
g Either (Group l Window) (Group l Window)
eg ((Uniq
id:[Uniq]
ids, [Uniq]
seen), [Either (Group l Window) (Group l Window)]
egs) = if Uniq
myID Uniq -> [Uniq] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Uniq]
seen
                                  then (([Uniq]
ids, [Uniq]
seen), (Group l Window -> Group l Window)
-> Either (Group l Window) (Group l Window)
-> Either (Group l Window) (Group l Window)
forall a b. (a -> b) -> Either a a -> Either b b
mapE_ (Uniq -> Group l Window -> Group l Window
forall (l :: * -> *). Uniq -> Group l Window -> Group l Window
setID Uniq
id) Either (Group l Window) (Group l Window)
egEither (Group l Window) (Group l Window)
-> [Either (Group l Window) (Group l Window)]
-> [Either (Group l Window) (Group l Window)]
forall a. a -> [a] -> [a]
:[Either (Group l Window) (Group l Window)]
egs)
                                  else ((Uniq
idUniq -> [Uniq] -> [Uniq]
forall a. a -> [a] -> [a]
:[Uniq]
ids, Uniq
myIDUniq -> [Uniq] -> [Uniq]
forall a. a -> [a] -> [a]
:[Uniq]
seen), Either (Group l Window) (Group l Window)
egEither (Group l Window) (Group l Window)
-> [Either (Group l Window) (Group l Window)]
-> [Either (Group l Window) (Group l Window)]
forall a. a -> [a] -> [a]
:[Either (Group l Window) (Group l Window)]
egs)
    where myID :: Uniq
myID = WithID l Window -> Uniq
forall (l :: * -> *) a. WithID l a -> Uniq
getID (WithID l Window -> Uniq) -> WithID l Window -> Uniq
forall a b. (a -> b) -> a -> b
$ Group l Window -> WithID l Window
forall (l :: * -> *) a. Group l a -> WithID l a
gLayout (Group l Window -> WithID l Window)
-> Group l Window -> WithID l Window
forall a b. (a -> b) -> a -> b
$ Either (Group l Window) (Group l Window) -> Group l Window
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
_) Zipper Window
z) = WithID l Window -> Zipper Window -> Group l Window
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G (Uniq -> l Window -> WithID l Window
forall (l :: * -> *) a. Uniq -> l a -> WithID l a
ID Uniq
id (l Window -> WithID l Window) -> l Window -> WithID l Window
forall a b. (a -> b) -> a -> b
$ Groups l l2 Window -> l Window
forall (l :: * -> *) (l2 :: * -> *) a. Groups l l2 a -> l a
baseLayout Groups l l2 Window
g) Zipper Window
z

-- ** Misc. ModifySpecs

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | helper
_removeFocused :: W.Stack a -> (a, Zipper a)
_removeFocused :: Stack a -> (a, Zipper a)
_removeFocused (W.Stack a
f (a
u:[a]
up) [a]
down) = (a
f, Stack a -> Zipper a
forall a. a -> Maybe a
Just (Stack a -> Zipper a) -> Stack a -> Zipper a
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a] -> Stack a
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, Stack a -> Zipper a
forall a. a -> Maybe a
Just (Stack a -> Zipper a) -> Stack a -> Zipper a
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
d [] [a]
down)
_removeFocused (W.Stack a
f [] []) = (a
f, Zipper a
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 :: 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) <- Stack (Group l Window) -> Group l Window
forall a. Stack a -> a
W.focus Stack (Group l Window)
s
    = let (Window
w, Zipper Window
f') = Stack Window -> (Window, Zipper Window)
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 = WithID l Window -> Zipper Window -> Group l Window
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l Zipper Window
f' }
      in Group l Window
-> Zipper (Group l Window) -> Zipper (Group l Window)
insertX (WithID l Window -> Zipper Window -> Group l Window
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l0 (Zipper Window -> Group l Window)
-> Zipper Window -> Group l Window
forall a b. (a -> b) -> a -> b
$ Window -> Zipper Window
forall a. a -> Zipper a
singletonZ Window
w) (Zipper (Group l Window) -> Zipper (Group l Window))
-> Zipper (Group l Window) -> Zipper (Group l Window)
forall a b. (a -> b) -> a -> b
$ Stack (Group l Window) -> Zipper (Group l Window)
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)
_ = Stack (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 :: WithID l Window
-> Zipper (Group l Window) -> Zipper (Group l Window)
moveToNewGroupUp WithID l Window
_ Zipper (Group l Window)
Nothing = Zipper (Group l Window)
forall a. Maybe a
Nothing
moveToNewGroupUp WithID l Window
l0 (Just Stack (Group l Window)
s) = WithID l Window
-> Stack (Group l Window)
-> (Group l Window
    -> Zipper (Group l Window) -> Zipper (Group l Window))
-> Zipper (Group l Window)
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)
forall a. a -> Zipper a -> Zipper a
insertUpZ

-- | Move the focused window to a new group after the current one.
moveToNewGroupDown :: ModifySpec
moveToNewGroupDown :: WithID l Window
-> Zipper (Group l Window) -> Zipper (Group l Window)
moveToNewGroupDown WithID l Window
_ Zipper (Group l Window)
Nothing = Zipper (Group l Window)
forall a. Maybe a
Nothing
moveToNewGroupDown WithID l Window
l0 (Just Stack (Group l Window)
s) = WithID l Window
-> Stack (Group l Window)
-> (Group l Window
    -> Zipper (Group l Window) -> Zipper (Group l Window))
-> Zipper (Group l Window)
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)
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 = Maybe (Stack (Group l Window))
forall a. Maybe a
Nothing
moveToGroupUp Bool
False WithID l Window
l0 (Just Stack (Group l Window)
s) = if [Group l Window] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Stack (Group l Window) -> [Group l Window]
forall a. Stack a -> [a]
W.up Stack (Group l Window)
s) then WithID l Window
-> Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window))
ModifySpec
moveToNewGroupUp WithID l Window
l0 (Stack (Group l Window) -> Maybe (Stack (Group l Window))
forall a. a -> Maybe a
Just Stack (Group l Window)
s)
                                                   else Bool
-> WithID l Window
-> Maybe (Stack (Group l Window))
-> Maybe (Stack (Group l Window))
Bool -> ModifySpec
moveToGroupUp Bool
True WithID l Window
l0 (Stack (Group l Window) -> Maybe (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 Group l Window
_ [] [])) = Stack (Group l Window) -> Maybe (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, Zipper Window
f') = Stack Window -> (Window, Zipper Window)
forall a. Stack a -> (a, Zipper a)
_removeFocused Stack Window
f
      in (Group l Window -> Group l Window)
-> Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window))
forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ ((Zipper Window -> Zipper Window)
-> Group l Window -> Group l Window
forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper ((Zipper Window -> Zipper Window)
 -> Group l Window -> Group l Window)
-> (Zipper Window -> Zipper Window)
-> Group l Window
-> Group l Window
forall a b. (a -> b) -> a -> b
$ Window -> Zipper Window -> Zipper Window
forall a. a -> Zipper a -> Zipper a
insertUpZ Window
w) (Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window)))
-> Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window))
forall a b. (a -> b) -> a -> b
$ Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window))
forall a. Zipper a -> Zipper a
focusUpZ (Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window)))
-> Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window))
forall a b. (a -> b) -> a -> b
$ Stack (Group l Window) -> Maybe (Stack (Group l Window))
forall a. a -> Maybe a
Just Stack (Group l Window)
s { focus :: Group l Window
W.focus = WithID l Window -> Zipper Window -> Group l Window
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l Zipper 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 = Maybe (Stack (Group l Window))
forall a. Maybe a
Nothing
moveToGroupDown Bool
False WithID l Window
l0 (Just Stack (Group l Window)
s) = if [Group l Window] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Stack (Group l Window) -> [Group l Window]
forall a. Stack a -> [a]
W.down Stack (Group l Window)
s) then WithID l Window
-> Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window))
ModifySpec
moveToNewGroupDown WithID l Window
l0 (Stack (Group l Window) -> Maybe (Stack (Group l Window))
forall a. a -> Maybe a
Just Stack (Group l Window)
s)
                                                       else Bool
-> WithID l Window
-> Maybe (Stack (Group l Window))
-> Maybe (Stack (Group l Window))
Bool -> ModifySpec
moveToGroupDown Bool
True WithID l Window
l0 (Stack (Group l Window) -> Maybe (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 Group l Window
_ [] [])) = Stack (Group l Window) -> Maybe (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, Zipper Window
f') = Stack Window -> (Window, Zipper Window)
forall a. Stack a -> (a, Zipper a)
_removeFocused Stack Window
f
      in (Group l Window -> Group l Window)
-> Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window))
forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ ((Zipper Window -> Zipper Window)
-> Group l Window -> Group l Window
forall a (l :: * -> *).
(Zipper a -> Zipper a) -> Group l a -> Group l a
onZipper ((Zipper Window -> Zipper Window)
 -> Group l Window -> Group l Window)
-> (Zipper Window -> Zipper Window)
-> Group l Window
-> Group l Window
forall a b. (a -> b) -> a -> b
$ Window -> Zipper Window -> Zipper Window
forall a. a -> Zipper a -> Zipper a
insertUpZ Window
w) (Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window)))
-> Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window))
forall a b. (a -> b) -> a -> b
$ Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window))
forall a. Zipper a -> Zipper a
focusDownZ (Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window)))
-> Maybe (Stack (Group l Window)) -> Maybe (Stack (Group l Window))
forall a b. (a -> b) -> a -> b
$ Stack (Group l Window) -> Maybe (Stack (Group l Window))
forall a. a -> Maybe a
Just Stack (Group l Window)
s { focus :: Group l Window
W.focus = WithID l Window -> Zipper Window -> Group l Window
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l Zipper 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 :: WithID l Window
-> Zipper (Group l Window) -> Zipper (Group l Window)
splitGroup WithID l Window
_ Zipper (Group l Window)
Nothing = Zipper (Group l Window)
forall a. Maybe a
Nothing
splitGroup WithID l Window
l0 z :: Zipper (Group l Window)
z@(Just Stack (Group l Window)
s) | G WithID l Window
l (Just Stack Window
ws) <- Stack (Group l Window) -> Group l Window
forall a. Stack a -> a
W.focus Stack (Group l Window)
s
    = case Stack Window
ws of
        W.Stack Window
_ [] [] -> Zipper (Group l Window)
z
        W.Stack Window
f (Window
u:[Window]
up) [] -> let g1 :: Group l Window
g1 = WithID l Window -> Zipper Window -> Group l Window
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l  (Zipper Window -> Group l Window)
-> Zipper Window -> Group l Window
forall a b. (a -> b) -> a -> b
$ Stack Window -> Zipper Window
forall a. a -> Maybe a
Just (Stack Window -> Zipper Window) -> Stack Window -> Zipper Window
forall a b. (a -> b) -> a -> b
$ Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
f [] []
                                   g2 :: Group l Window
g2 = WithID l Window -> Zipper Window -> Group l Window
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l0 (Zipper Window -> Group l Window)
-> Zipper Window -> Group l Window
forall a b. (a -> b) -> a -> b
$ Stack Window -> Zipper Window
forall a. a -> Maybe a
Just (Stack Window -> Zipper Window) -> Stack Window -> Zipper Window
forall a b. (a -> b) -> a -> b
$ Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
u [Window]
up []
                               in Group l Window
-> Zipper (Group l Window) -> Zipper (Group l Window)
forall a. a -> Zipper a -> Zipper a
insertDownZ Group l Window
g1 (Zipper (Group l Window) -> Zipper (Group l Window))
-> Zipper (Group l Window) -> Zipper (Group l Window)
forall a b. (a -> b) -> a -> b
$ (Group l Window -> Group l Window)
-> Zipper (Group l Window) -> Zipper (Group l Window)
forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ (Group l Window -> Group l Window -> Group l Window
forall a b. a -> b -> a
const Group l Window
g2) Zipper (Group l Window)
z
        W.Stack Window
f [Window]
up (Window
d:[Window]
down) -> let g1 :: Group l Window
g1 = WithID l Window -> Zipper Window -> Group l Window
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l  (Zipper Window -> Group l Window)
-> Zipper Window -> Group l Window
forall a b. (a -> b) -> a -> b
$ Stack Window -> Zipper Window
forall a. a -> Maybe a
Just (Stack Window -> Zipper Window) -> Stack Window -> Zipper Window
forall a b. (a -> b) -> a -> b
$ Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
f [Window]
up []
                                     g2 :: Group l Window
g2 = WithID l Window -> Zipper Window -> Group l Window
forall (l :: * -> *) a. WithID l a -> Zipper a -> Group l a
G WithID l Window
l0 (Zipper Window -> Group l Window)
-> Zipper Window -> Group l Window
forall a b. (a -> b) -> a -> b
$ Stack Window -> Zipper Window
forall a. a -> Maybe a
Just (Stack Window -> Zipper Window) -> Stack Window -> Zipper Window
forall a b. (a -> b) -> a -> b
$ Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
d [] [Window]
down
                                 in Group l Window
-> Zipper (Group l Window) -> Zipper (Group l Window)
forall a. a -> Zipper a -> Zipper a
insertUpZ Group l Window
g1 (Zipper (Group l Window) -> Zipper (Group l Window))
-> Zipper (Group l Window) -> Zipper (Group l Window)
forall a b. (a -> b) -> a -> b
$ (Group l Window -> Group l Window)
-> Zipper (Group l Window) -> Zipper (Group l Window)
forall a. (a -> a) -> Zipper a -> Zipper a
onFocusedZ (Group l Window -> Group l Window -> Group l Window
forall a b. a -> b -> a
const Group l Window
g2) Zipper (Group l Window)
z
splitGroup WithID l Window
_ Zipper (Group l Window)
_ = Zipper (Group l Window)
forall a. Maybe a
Nothing