{-# 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] ids) = 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] -> Uniq forall a. [a] -> a head [Uniq] ids) (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] ids) = 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] -> Uniq forall a. [a] -> a head [Uniq] ids) (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] ids) = 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] -> Uniq forall a. [a] -> a head [Uniq] ids) (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 -> 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)) -- | 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] 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] -> Uniq forall a. [a] -> a head [Uniq] ids) (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] -> [Uniq] forall a. [a] -> [a] tail [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] 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] -> Uniq forall a. [a] -> a head [Uniq] ids) (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] -> [Uniq] forall a. [a] -> [a] tail [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