{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.SubLayouts
-- Description :  A layout combinator that allows layouts to be nested.
-- Copyright   :  (c) 2009 Adam Vogt
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  vogt.adam@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout combinator that allows layouts to be nested.
--
-----------------------------------------------------------------------------

module XMonad.Layout.SubLayouts (
    -- * Usage
    -- $usage
    subLayout,
    subTabbed,

    pushGroup, pullGroup,
    pushWindow, pullWindow,
    onGroup, toSubl, mergeDir,

    GroupMsg(..),
    Broadcast(..),

    defaultSublMap,

    Sublayout,

    -- * Screenshots
    -- $screenshots

    -- * Todo
    -- $todo
    )
    where

import XMonad.Layout.Circle () -- so haddock can find the link

import XMonad.Layout.Decoration(Decoration, DefaultShrinker)
import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout,
                                    redoLayout),
                                    ModifiedLayout(..))
import XMonad.Layout.Simplest(Simplest(..))
import XMonad.Layout.Tabbed(shrinkText,
                            TabbedDecoration, addTabs)
import XMonad.Layout.WindowNavigation(Navigate(Apply))
import XMonad.Util.Invisible(Invisible(..))
import XMonad.Util.Types(Direction2D(..))
import XMonad hiding (def)
import XMonad.Prelude
import Control.Arrow(Arrow(second, (&&&)))

import qualified XMonad as X
import qualified XMonad.Layout.BoringWindows as B
import qualified XMonad.StackSet as W
import qualified Data.Map as M
import Data.Map(Map)
import qualified Data.Set as S

-- $screenshots
--
-- <<http://haskell.org/sitewiki/images/thumb/8/8b/Xmonad-SubLayouts-xinerama.png/480px-Xmonad-SubLayouts-xinerama.png>>
--
-- Larger version: <http://haskell.org/sitewiki/images/8/8b/Xmonad-SubLayouts-xinerama.png>

-- $todo
--  /Issue 288/
--
--  "XMonad.Layout.ResizableTile" assumes that its environment
--  contains only the windows it is running: sublayouts are currently run with
--  the stack containing only the windows passed to it in its environment, but
--  any changes that the layout makes are not merged back.
--
--  Should the behavior be made optional?
--
--  /Features/
--
--   * suggested managehooks for merging specific windows, or the apropriate
--     layout based hack to find out the number of groups currently showed, but
--     the size of current window groups is not available (outside of this
--     growing module)
--
--  /SimpleTabbed as a SubLayout/
--
--  'subTabbed' works well, but it would be more uniform to avoid the use of
--  addTabs, with the sublayout being Simplest (but
--  'XMonad.Layout.Tabbed.simpleTabbed' is this...).  The only thing to be
--  gained by fixing this issue is the ability to mix and match decoration
--  styles. Better compatibility with some other layouts of which I am not
--  aware could be another benefit.
--
--  'simpleTabbed' (and other decorated layouts) fail horribly when used as
--  subLayouts:
--
--    * decorations stick around: layout is run after being told to Hide
--
--    * mouse events do not change focus: the group-ungroup does not respect
--      the focus changes it wants?
--
--    * sending ReleaseResources before running it makes xmonad very slow, and
--      still leaves borders sticking around
--

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.SubLayouts
-- > import XMonad.Layout.WindowNavigation
--
-- Using "XMonad.Layout.BoringWindows" is optional and it allows you to add a
-- keybinding to skip over the non-visible windows.
--
-- > import XMonad.Layout.BoringWindows
--
-- Then edit your @layoutHook@ by adding the 'subTabbed' layout modifier:
--
-- > myLayout = windowNavigation $ subTabbed $ boringWindows $
-- >                        Tall 1 (3/100) (1/2) ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- "XMonad.Layout.WindowNavigation" is used to specify which windows to merge,
-- and it is not integrated into the modifier because it can be configured, and
-- works best as the outer modifier.
--
-- Then to your keybindings add:
--
--  > , ((modm .|. controlMask, xK_h), sendMessage $ pullGroup L)
--  > , ((modm .|. controlMask, xK_l), sendMessage $ pullGroup R)
--  > , ((modm .|. controlMask, xK_k), sendMessage $ pullGroup U)
--  > , ((modm .|. controlMask, xK_j), sendMessage $ pullGroup D)
--  >
--  > , ((modm .|. controlMask, xK_m), withFocused (sendMessage . MergeAll))
--  > , ((modm .|. controlMask, xK_u), withFocused (sendMessage . UnMerge))
--  >
--  > , ((modm .|. controlMask, xK_period), onGroup W.focusUp')
--  > , ((modm .|. controlMask, xK_comma), onGroup W.focusDown')
--
--  These additional keybindings require the optional
--  "XMonad.Layout.BoringWindows" layoutModifier. The focus will skip over the
--  windows that are not focused in each sublayout.
--
--  > , ((modm, xK_j), focusDown)
--  > , ((modm, xK_k), focusUp)
--
--  A 'submap' can be used to make modifying the sublayouts using 'onGroup' and
--  'toSubl' simpler:
--
--  > ,((modm, xK_s), submap $ defaultSublMap conf)
--
--  /NOTE:/ is there some reason that @asks config >>= submap . defaultSublMap@
--  could not be used in the keybinding instead? It avoids having to explicitly
--  pass the conf.
--
-- For more detailed instructions, see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
-- "XMonad.Doc.Extending#Adding_key_bindings"

-- | The main layout modifier arguments:
--
-- @subLayout advanceInnerLayouts innerLayout outerLayout@
--
--  [@advanceInnerLayouts@] When a new group at index @n@ in the outer layout
--  is created (even with one element), the @innerLayout@ is used as the
--  layout within that group after being advanced with @advanceInnerLayouts !!
--  n@ 'NextLayout' messages. If there is no corresponding element in the
--  @advanceInnerLayouts@ list, then @innerLayout@ is not given any 'NextLayout'
--  messages.
--
--  [@innerLayout@] The single layout given to be run as a sublayout.
--
--  [@outerLayout@] The layout that determines the rectangles given to each
--  group.
--
--  Ex. The second group is 'Tall', the third is 'Circle', all others are tabbed
--  with:
--
--  > myLayout = addTabs shrinkText def
--  >          $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| Circle)
--  >          $ Tall 1 0.2 0.5 ||| Full
subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a
subLayout :: forall (subl :: * -> *) a (l :: * -> *).
[Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a
subLayout [Int]
nextLayout subl a
sl = Sublayout subl a -> l a -> ModifiedLayout (Sublayout subl) l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Invisible [] (SomeMessage, a)
-> ([Int], subl a) -> [(subl a, Stack a)] -> Sublayout subl a
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, a)] -> Invisible [] (SomeMessage, a)
forall (m :: * -> *) a. m a -> Invisible m a
I []) ([Int]
nextLayout,subl a
sl) [])

-- | @subTabbed@ is a use of 'subLayout' with 'addTabs' to show decorations.
subTabbed :: (Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) =>
    l a -> ModifiedLayout (Decoration TabbedDecoration DefaultShrinker)
                          (ModifiedLayout (Sublayout Simplest) l) a
subTabbed :: forall a (l :: * -> *).
(Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) =>
l a
-> ModifiedLayout
     (Decoration TabbedDecoration DefaultShrinker)
     (ModifiedLayout (Sublayout Simplest) l)
     a
subTabbed  l a
x = DefaultShrinker
-> Theme
-> ModifiedLayout (Sublayout Simplest) l a
-> ModifiedLayout
     (Decoration TabbedDecoration DefaultShrinker)
     (ModifiedLayout (Sublayout Simplest) l)
     a
forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabs DefaultShrinker
shrinkText Theme
forall a. Default a => a
X.def (ModifiedLayout (Sublayout Simplest) l a
 -> ModifiedLayout
      (Decoration TabbedDecoration DefaultShrinker)
      (ModifiedLayout (Sublayout Simplest) l)
      a)
-> ModifiedLayout (Sublayout Simplest) l a
-> ModifiedLayout
     (Decoration TabbedDecoration DefaultShrinker)
     (ModifiedLayout (Sublayout Simplest) l)
     a
forall a b. (a -> b) -> a -> b
$ [Int]
-> Simplest a -> l a -> ModifiedLayout (Sublayout Simplest) l a
forall (subl :: * -> *) a (l :: * -> *).
[Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a
subLayout [] Simplest a
forall a. Simplest a
Simplest l a
x

-- | @defaultSublMap@ is an attempt to create a set of keybindings like the
-- defaults ones but to be used as a 'submap' for sending messages to the
-- sublayout.
defaultSublMap :: XConfig l -> Map (KeyMask, KeySym) (X ())
defaultSublMap :: forall (l :: * -> *). XConfig l -> Map (KeyMask, Window) (X ())
defaultSublMap XConfig{ modMask :: forall (l :: * -> *). XConfig l -> KeyMask
modMask = KeyMask
modm } = [((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
         [((KeyMask
modm, Window
xK_space), ChangeLayout -> X ()
forall a. Message a => a -> X ()
toSubl ChangeLayout
NextLayout),
          ((KeyMask
modm, Window
xK_j), (Stack Window -> Stack Window) -> X ()
onGroup Stack Window -> Stack Window
forall a. Stack a -> Stack a
W.focusDown'),
          ((KeyMask
modm, Window
xK_k), (Stack Window -> Stack Window) -> X ()
onGroup Stack Window -> Stack Window
forall a. Stack a -> Stack a
W.focusUp'),
          ((KeyMask
modm, Window
xK_h), Resize -> X ()
forall a. Message a => a -> X ()
toSubl Resize
Shrink),
          ((KeyMask
modm, Window
xK_l), Resize -> X ()
forall a. Message a => a -> X ()
toSubl Resize
Expand),
          ((KeyMask
modm, Window
xK_Tab), (Stack Window -> Stack Window) -> X ()
onGroup Stack Window -> Stack Window
forall a. Stack a -> Stack a
W.focusDown'),
          ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_Tab), (Stack Window -> Stack Window) -> X ()
onGroup Stack Window -> Stack Window
forall a. Stack a -> Stack a
W.focusUp'),
          ((KeyMask
modm, Window
xK_m), (Stack Window -> Stack Window) -> X ()
onGroup Stack Window -> Stack Window
forall a. Stack a -> Stack a
focusMaster'),
          ((KeyMask
modm, Window
xK_comma), IncMasterN -> X ()
forall a. Message a => a -> X ()
toSubl (IncMasterN -> X ()) -> IncMasterN -> X ()
forall a b. (a -> b) -> a -> b
$ Int -> IncMasterN
IncMasterN Int
1),
          ((KeyMask
modm, Window
xK_period), IncMasterN -> X ()
forall a. Message a => a -> X ()
toSubl (IncMasterN -> X ()) -> IncMasterN -> X ()
forall a b. (a -> b) -> a -> b
$ Int -> IncMasterN
IncMasterN (-Int
1)),
          ((KeyMask
modm, Window
xK_Return), (Stack Window -> Stack Window) -> X ()
onGroup Stack Window -> Stack Window
forall a. Stack a -> Stack a
swapMaster')
         ]
        where
         -- should these go into XMonad.StackSet?
         focusMaster' :: Stack a -> Stack a
focusMaster' Stack a
st = let ([a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> a
f :| [a]
fs) = Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
st
            in a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [] [a]
fs
         swapMaster' :: Stack a -> Stack a
swapMaster' (W.Stack a
f [a]
u [a]
d) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [] ([a] -> Stack a) -> [a] -> Stack a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
u [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
d

data Sublayout l a = Sublayout
    { forall (l :: * -> *) a.
Sublayout l a -> Invisible [] (SomeMessage, a)
delayMess :: Invisible [] (SomeMessage,a)
                          -- ^ messages are handled when running the layout,
                          -- not in the handleMessage, I'm not sure that this
                          -- is necessary
    , forall (l :: * -> *) a. Sublayout l a -> ([Int], l a)
def :: ([Int], l a) -- ^ how many NextLayout messages to send to newly
                          -- populated layouts. If there is no corresponding
                          -- index, then don't send any.
    , forall (l :: * -> *) a. Sublayout l a -> [(l a, Stack a)]
subls :: [(l a,W.Stack a)]
                          -- ^ The sublayouts and the stacks they manage
    }
    deriving (ReadPrec [Sublayout l a]
ReadPrec (Sublayout l a)
Int -> ReadS (Sublayout l a)
ReadS [Sublayout l a]
(Int -> ReadS (Sublayout l a))
-> ReadS [Sublayout l a]
-> ReadPrec (Sublayout l a)
-> ReadPrec [Sublayout l a]
-> Read (Sublayout l a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec [Sublayout l a]
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec (Sublayout l a)
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
Int -> ReadS (Sublayout l a)
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadS [Sublayout l a]
readListPrec :: ReadPrec [Sublayout l a]
$creadListPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec [Sublayout l a]
readPrec :: ReadPrec (Sublayout l a)
$creadPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec (Sublayout l a)
readList :: ReadS [Sublayout l a]
$creadList :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadS [Sublayout l a]
readsPrec :: Int -> ReadS (Sublayout l a)
$creadsPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
Int -> ReadS (Sublayout l a)
Read,Int -> Sublayout l a -> ShowS
[Sublayout l a] -> ShowS
Sublayout l a -> String
(Int -> Sublayout l a -> ShowS)
-> (Sublayout l a -> String)
-> ([Sublayout l a] -> ShowS)
-> Show (Sublayout l a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Int -> Sublayout l a -> ShowS
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
[Sublayout l a] -> ShowS
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Sublayout l a -> String
showList :: [Sublayout l a] -> ShowS
$cshowList :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
[Sublayout l a] -> ShowS
show :: Sublayout l a -> String
$cshow :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Sublayout l a -> String
showsPrec :: Int -> Sublayout l a -> ShowS
$cshowsPrec :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Int -> Sublayout l a -> ShowS
Show)

-- | Groups assumes this invariant:
--     M.keys gs == map W.focus (M.elems gs)  (ignoring order)
--     All windows in the workspace are in the Map
--
-- The keys are visible windows, the rest are hidden.
--
-- This representation probably simplifies the internals of the modifier.
type Groups a = Map a (W.Stack a)

-- | Stack of stacks, a simple representation of groups for purposes of focus.
type GroupStack a = W.Stack (W.Stack a)

-- | GroupMsg take window parameters to determine which group the action should
-- be applied to
data GroupMsg a
    = UnMerge a -- ^ free the focused window from its tab stack
    | UnMergeAll a
                -- ^ separate the focused group into singleton groups
    | Merge a a -- ^ merge the first group into the second group
    | MergeAll a
                -- ^ make one large group, keeping the parameter focused
    | Migrate a a
                -- ^ used to the window named in the first argument to the
                -- second argument's group, this may be replaced by a
                -- combination of 'UnMerge' and 'Merge'
    | WithGroup (W.Stack a -> X (W.Stack a)) a
    | SubMessage SomeMessage  a
                -- ^ the sublayout with the given window will get the message

-- | merge the window that would be focused by the function when applied to the
-- W.Stack of all windows, with the current group removed. The given window
-- should be focused by a sublayout. Example usage: @withFocused (sendMessage .
-- mergeDir W.focusDown')@
mergeDir :: (W.Stack Window -> W.Stack Window) -> Window -> GroupMsg Window
mergeDir :: (Stack Window -> Stack Window) -> Window -> GroupMsg Window
mergeDir Stack Window -> Stack Window
f = (Stack Window -> X (Stack Window)) -> Window -> GroupMsg Window
forall a. (Stack a -> X (Stack a)) -> a -> GroupMsg a
WithGroup Stack Window -> X (Stack Window)
g
 where g :: Stack Window -> X (Stack Window)
g Stack Window
cs = do
        let onlyOthers :: Stack Window -> Maybe (Stack Window)
onlyOthers = (Window -> Bool) -> Stack Window -> Maybe (Stack Window)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Stack Window
cs)
        (Maybe (Stack Window) -> (Stack Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
`whenJust` GroupMsg Window -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg Window -> X ())
-> (Stack Window -> GroupMsg Window) -> Stack Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Window -> GroupMsg Window
forall a. a -> a -> GroupMsg a
Merge (Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
cs) (Window -> GroupMsg Window)
-> (Stack Window -> Window) -> Stack Window -> GroupMsg Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Window
forall a. Stack a -> a
W.focus (Stack Window -> Window)
-> (Stack Window -> Stack Window) -> Stack Window -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Stack Window
f)
            (Maybe (Stack Window) -> X ())
-> (Maybe (Stack Window) -> Maybe (Stack Window))
-> Maybe (Stack Window)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack Window -> Maybe (Stack Window)
onlyOthers (Stack Window -> Maybe (Stack Window))
-> Maybe (Stack Window) -> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
          (Maybe (Stack Window) -> X ()) -> X (Maybe (Stack Window)) -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X (Maybe (Stack Window))
currentStack
        Stack Window -> X (Stack Window)
forall (m :: * -> *) a. Monad m => a -> m a
return Stack Window
cs

newtype Broadcast = Broadcast SomeMessage -- ^ send a message to all sublayouts

instance Message Broadcast
instance Typeable a => Message (GroupMsg a)

-- | @pullGroup@, @pushGroup@ allow you to merge windows or groups inheriting
-- the position of the current window (pull) or the other window (push).
--
-- @pushWindow@ and @pullWindow@ move individual windows between groups. They
-- are less effective at preserving window positions.
pullGroup,pushGroup,pullWindow,pushWindow :: Direction2D -> Navigate
pullGroup :: Direction2D -> Navigate
pullGroup = (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav (\Window
o Window
c -> GroupMsg Window -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg Window -> X ()) -> GroupMsg Window -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> Window -> GroupMsg Window
forall a. a -> a -> GroupMsg a
Merge Window
o Window
c)
pushGroup :: Direction2D -> Navigate
pushGroup = (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav (\Window
o Window
c -> GroupMsg Window -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg Window -> X ()) -> GroupMsg Window -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> Window -> GroupMsg Window
forall a. a -> a -> GroupMsg a
Merge Window
c Window
o)
pullWindow :: Direction2D -> Navigate
pullWindow = (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav (\Window
o Window
c -> GroupMsg Window -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg Window -> X ()) -> GroupMsg Window -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> Window -> GroupMsg Window
forall a. a -> a -> GroupMsg a
Migrate Window
o Window
c)
pushWindow :: Direction2D -> Navigate
pushWindow = (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav (\Window
o Window
c -> GroupMsg Window -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg Window -> X ()) -> GroupMsg Window -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> Window -> GroupMsg Window
forall a. a -> a -> GroupMsg a
Migrate Window
c Window
o)

mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate
mergeNav Window -> Window -> X ()
f = (Window -> X ()) -> Direction2D -> Navigate
Apply ((Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ())
-> (Window -> Window -> X ()) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Window -> X ()
f)

-- | Apply a function on the stack belonging to the currently focused group. It
-- works for rearranging windows and for changing focus.
onGroup :: (W.Stack Window -> W.Stack Window) -> X ()
onGroup :: (Stack Window -> Stack Window) -> X ()
onGroup Stack Window -> Stack Window
f = (Window -> X ()) -> X ()
withFocused (GroupMsg Window -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg Window -> X ())
-> (Window -> GroupMsg Window) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack Window -> X (Stack Window)) -> Window -> GroupMsg Window
forall a. (Stack a -> X (Stack a)) -> a -> GroupMsg a
WithGroup (Stack Window -> X (Stack Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stack Window -> X (Stack Window))
-> (Stack Window -> Stack Window)
-> Stack Window
-> X (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Stack Window
f))

-- | Send a message to the currently focused sublayout.
toSubl :: (Message a) => a -> X ()
toSubl :: forall a. Message a => a -> X ()
toSubl a
m = (Window -> X ()) -> X ()
withFocused (GroupMsg Window -> X ()
forall a. Message a => a -> X ()
sendMessage (GroupMsg Window -> X ())
-> (Window -> GroupMsg Window) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeMessage -> Window -> GroupMsg Window
forall a. SomeMessage -> a -> GroupMsg a
SubMessage (a -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage a
m))

instance forall l. (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where
    modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
Sublayout l Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout Sublayout{ subls :: forall (l :: * -> *) a. Sublayout l a -> [(l a, Stack a)]
subls = [(l Window, Stack Window)]
osls } (W.Workspace String
i l Window
la Maybe (Stack Window)
st) Rectangle
r = do
            let gs' :: Groups Window
gs' = Maybe (Stack Window) -> Groups Window -> Groups Window
forall a. Ord a => Maybe (Stack a) -> Groups a -> Groups a
updateGroup Maybe (Stack Window)
st (Groups Window -> Groups Window) -> Groups Window -> Groups Window
forall a b. (a -> b) -> a -> b
$ [(l Window, Stack Window)] -> Groups Window
forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(l Window, Stack Window)]
osls
                st' :: Maybe (Stack Window)
st' = (Window -> Bool) -> Stack Window -> Maybe (Stack Window)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Groups Window -> [Window]
forall k a. Map k a -> [k]
M.keys Groups Window
gs') (Stack Window -> Maybe (Stack Window))
-> Maybe (Stack Window) -> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Stack Window)
st
            Groups Window -> X ()
updateWs Groups Window
gs'
            Maybe (Stack Window)
oldStack <- X (Maybe (Stack Window))
currentStack
            Maybe (Stack Window) -> X ()
setStack Maybe (Stack Window)
st'
            Workspace String (l Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l Window
-> Maybe (Stack Window)
-> Workspace String (l Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
i l Window
la Maybe (Stack Window)
st') Rectangle
r X ([(Window, Rectangle)], Maybe (l Window))
-> X () -> X ([(Window, Rectangle)], Maybe (l Window))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Maybe (Stack Window) -> X ()
setStack Maybe (Stack Window)
oldStack
            -- FIXME: merge back reordering, deletions?

    redoLayout :: Sublayout l Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe (Sublayout l Window))
redoLayout Sublayout{ delayMess :: forall (l :: * -> *) a.
Sublayout l a -> Invisible [] (SomeMessage, a)
delayMess = I [(SomeMessage, Window)]
ms, def :: forall (l :: * -> *) a. Sublayout l a -> ([Int], l a)
def = ([Int], l Window)
defl, subls :: forall (l :: * -> *) a. Sublayout l a -> [(l a, Stack a)]
subls = [(l Window, Stack Window)]
osls } Rectangle
_r Maybe (Stack Window)
st [(Window, Rectangle)]
arrs = do
        let gs' :: Groups Window
gs' = Maybe (Stack Window) -> Groups Window -> Groups Window
forall a. Ord a => Maybe (Stack a) -> Groups a -> Groups a
updateGroup Maybe (Stack Window)
st (Groups Window -> Groups Window) -> Groups Window -> Groups Window
forall a b. (a -> b) -> a -> b
$ [(l Window, Stack Window)] -> Groups Window
forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(l Window, Stack Window)]
osls
        [(Bool, (l Window, Stack Window))]
sls <- ([Int], l Window)
-> Maybe (Stack Window)
-> Groups Window
-> [(l Window, Stack Window)]
-> X [(Bool, (l Window, Stack Window))]
forall (layout :: * -> *) a k b.
(LayoutClass layout a, Ord k) =>
([Int], layout a)
-> Maybe (Stack k)
-> Groups k
-> [(layout a, b)]
-> X [(Bool, (layout a, Stack k))]
fromGroups ([Int], l Window)
defl Maybe (Stack Window)
st Groups Window
gs' [(l Window, Stack Window)]
osls

        let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> l Window -> Bool
                    -> Maybe (W.Stack Window) -> X ([(Window, Rectangle)], l Window)
            newL :: LayoutClass l Window =>
Rectangle
-> String
-> l Window
-> Bool
-> Maybe (Stack Window)
-> X ([(Window, Rectangle)], l Window)
newL Rectangle
rect String
n l Window
ol Bool
isNew Maybe (Stack Window)
sst = do
                Maybe (Stack Window)
orgStack <- X (Maybe (Stack Window))
currentStack
                let handle :: layout a -> (SomeMessage, b) -> X (layout a)
handle layout a
l (SomeMessage
y,b
_)
                        | Bool -> Bool
not Bool
isNew = layout a -> Maybe (layout a) -> layout a
forall a. a -> Maybe a -> a
fromMaybe layout a
l (Maybe (layout a) -> layout a)
-> X (Maybe (layout a)) -> X (layout a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> layout a -> SomeMessage -> X (Maybe (layout a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage layout a
l SomeMessage
y
                        | Bool
otherwise = layout a -> X (layout a)
forall (m :: * -> *) a. Monad m => a -> m a
return layout a
l
                    kms :: [(SomeMessage, Window)]
kms = ((SomeMessage, Window) -> Bool)
-> [(SomeMessage, Window)] -> [(SomeMessage, Window)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Groups Window -> [Window]
forall k a. Map k a -> [k]
M.keys Groups Window
gs') (Window -> Bool)
-> ((SomeMessage, Window) -> Window)
-> (SomeMessage, Window)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeMessage, Window) -> Window
forall a b. (a, b) -> b
snd) [(SomeMessage, Window)]
ms
                Maybe (Stack Window) -> X ()
setStack Maybe (Stack Window)
sst
                l Window
nl <- (l Window -> (SomeMessage, Window) -> X (l Window))
-> l Window -> [(SomeMessage, Window)] -> X (l Window)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM l Window -> (SomeMessage, Window) -> X (l Window)
forall {layout :: * -> *} {a} {b}.
LayoutClass layout a =>
layout a -> (SomeMessage, b) -> X (layout a)
handle l Window
ol ([(SomeMessage, Window)] -> X (l Window))
-> [(SomeMessage, Window)] -> X (l Window)
forall a b. (a -> b) -> a -> b
$ ((SomeMessage, Window) -> Bool)
-> [(SomeMessage, Window)] -> [(SomeMessage, Window)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack Window)
sst) (Window -> Bool)
-> ((SomeMessage, Window) -> Window)
-> (SomeMessage, Window)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeMessage, Window) -> Window
forall a b. (a, b) -> b
snd) [(SomeMessage, Window)]
kms
                ([(Window, Rectangle)], Maybe (l Window))
result <- Workspace String (l Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l Window
-> Maybe (Stack Window)
-> Workspace String (l Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
n l Window
nl Maybe (Stack Window)
sst) Rectangle
rect
                Maybe (Stack Window) -> X ()
setStack Maybe (Stack Window)
orgStack -- FIXME: merge back reordering, deletions?
                ([(Window, Rectangle)], l Window)
-> X ([(Window, Rectangle)], l Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Window, Rectangle)], l Window)
 -> X ([(Window, Rectangle)], l Window))
-> ([(Window, Rectangle)], l Window)
-> X ([(Window, Rectangle)], l Window)
forall a b. (a -> b) -> a -> b
$ l Window -> Maybe (l Window) -> l Window
forall a. a -> Maybe a -> a
fromMaybe l Window
nl (Maybe (l Window) -> l Window)
-> ([(Window, Rectangle)], Maybe (l Window))
-> ([(Window, Rectangle)], l Window)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
`second` ([(Window, Rectangle)], Maybe (l Window))
result

            ([X ([(Window, Rectangle)], l Window)]
urls,[Maybe (Stack Window)]
ssts) = [(X ([(Window, Rectangle)], l Window), Maybe (Stack Window))]
-> ([X ([(Window, Rectangle)], l Window)], [Maybe (Stack Window)])
forall a b. [(a, b)] -> ([a], [b])
unzip [ (Rectangle
-> String
-> l Window
-> Bool
-> Maybe (Stack Window)
-> X ([(Window, Rectangle)], l Window)
LayoutClass l Window =>
Rectangle
-> String
-> l Window
-> Bool
-> Maybe (Stack Window)
-> X ([(Window, Rectangle)], l Window)
newL Rectangle
gr String
i l Window
l Bool
isNew Maybe (Stack Window)
sst, Maybe (Stack Window)
sst)
                    | (Bool
isNew,(l Window
l,Stack Window
_st)) <- [(Bool, (l Window, Stack Window))]
sls
                    | String
i <- (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [ Int
0 :: Int .. ]
                    | (Window
k,Rectangle
gr) <- [(Window, Rectangle)]
arrs, let sst :: Maybe (Stack Window)
sst = Window -> Groups Window -> Maybe (Stack Window)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
k Groups Window
gs' ]

        [([(Window, Rectangle)], l Window)]
arrs' <- [X ([(Window, Rectangle)], l Window)]
-> X [([(Window, Rectangle)], l Window)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [X ([(Window, Rectangle)], l Window)]
urls
        Maybe (Sublayout l Window)
sls' <- Sublayout l Window -> Maybe (Sublayout l Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sublayout l Window -> Maybe (Sublayout l Window))
-> ([(Bool, (l Window, Stack Window))] -> Sublayout l Window)
-> [(Bool, (l Window, Stack Window))]
-> Maybe (Sublayout l Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Invisible [] (SomeMessage, Window)
-> ([Int], l Window)
-> [(l Window, Stack Window)]
-> Sublayout l Window
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, Window)] -> Invisible [] (SomeMessage, Window)
forall (m :: * -> *) a. m a -> Invisible m a
I []) ([Int], l Window)
defl ([(l Window, Stack Window)] -> Sublayout l Window)
-> ([(Bool, (l Window, Stack Window))]
    -> [(l Window, Stack Window)])
-> [(Bool, (l Window, Stack Window))]
-> Sublayout l Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, (l Window, Stack Window)) -> (l Window, Stack Window))
-> [(Bool, (l Window, Stack Window))] -> [(l Window, Stack Window)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, (l Window, Stack Window)) -> (l Window, Stack Window)
forall a b. (a, b) -> b
snd ([(Bool, (l Window, Stack Window))] -> Maybe (Sublayout l Window))
-> X [(Bool, (l Window, Stack Window))]
-> X (Maybe (Sublayout l Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Int], l Window)
-> Maybe (Stack Window)
-> Groups Window
-> [(l Window, Stack Window)]
-> X [(Bool, (l Window, Stack Window))]
forall (layout :: * -> *) a k b.
(LayoutClass layout a, Ord k) =>
([Int], layout a)
-> Maybe (Stack k)
-> Groups k
-> [(layout a, b)]
-> X [(Bool, (layout a, Stack k))]
fromGroups ([Int], l Window)
defl Maybe (Stack Window)
st Groups Window
gs'
                        [ (l Window
l,Stack Window
s) | ([(Window, Rectangle)]
_,l Window
l) <- [([(Window, Rectangle)], l Window)]
arrs' | (Just Stack Window
s) <- [Maybe (Stack Window)]
ssts ]
        ([(Window, Rectangle)], Maybe (Sublayout l Window))
-> X ([(Window, Rectangle)], Maybe (Sublayout l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ((([(Window, Rectangle)], l Window) -> [(Window, Rectangle)])
-> [([(Window, Rectangle)], l Window)] -> [(Window, Rectangle)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(Window, Rectangle)], l Window) -> [(Window, Rectangle)]
forall a b. (a, b) -> a
fst [([(Window, Rectangle)], l Window)]
arrs', Maybe (Sublayout l Window)
sls')

    handleMess :: Sublayout l Window -> SomeMessage -> X (Maybe (Sublayout l Window))
handleMess (Sublayout (I [(SomeMessage, Window)]
ms) ([Int], l Window)
defl [(l Window, Stack Window)]
sls) SomeMessage
m
        | Just (SubMessage SomeMessage
sm Window
w) <- SomeMessage -> Maybe (GroupMsg Window)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window)))
-> Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window))
forall a b. (a -> b) -> a -> b
$ Sublayout l Window -> Maybe (Sublayout l Window)
forall a. a -> Maybe a
Just (Sublayout l Window -> Maybe (Sublayout l Window))
-> Sublayout l Window -> Maybe (Sublayout l Window)
forall a b. (a -> b) -> a -> b
$ Invisible [] (SomeMessage, Window)
-> ([Int], l Window)
-> [(l Window, Stack Window)]
-> Sublayout l Window
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, Window)] -> Invisible [] (SomeMessage, Window)
forall (m :: * -> *) a. m a -> Invisible m a
I ((SomeMessage
sm,Window
w)(SomeMessage, Window)
-> [(SomeMessage, Window)] -> [(SomeMessage, Window)]
forall a. a -> [a] -> [a]
:[(SomeMessage, Window)]
ms)) ([Int], l Window)
defl [(l Window, Stack Window)]
sls

        | Just (Broadcast SomeMessage
sm) <- SomeMessage -> Maybe Broadcast
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
            [(SomeMessage, Window)]
ms' <- (Maybe (Stack Window) -> [(SomeMessage, Window)])
-> X (Maybe (Stack Window)) -> X [(SomeMessage, Window)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SomeMessage] -> [Window] -> [(SomeMessage, Window)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SomeMessage -> [SomeMessage]
forall a. a -> [a]
repeat SomeMessage
sm) ([Window] -> [(SomeMessage, Window)])
-> (Maybe (Stack Window) -> [Window])
-> Maybe (Stack Window)
-> [(SomeMessage, Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate') X (Maybe (Stack Window))
currentStack
            Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window)))
-> Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window))
forall a b. (a -> b) -> a -> b
$ if [(SomeMessage, Window)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SomeMessage, Window)]
ms' then Maybe (Sublayout l Window)
forall a. Maybe a
Nothing
                else Sublayout l Window -> Maybe (Sublayout l Window)
forall a. a -> Maybe a
Just (Sublayout l Window -> Maybe (Sublayout l Window))
-> Sublayout l Window -> Maybe (Sublayout l Window)
forall a b. (a -> b) -> a -> b
$ Invisible [] (SomeMessage, Window)
-> ([Int], l Window)
-> [(l Window, Stack Window)]
-> Sublayout l Window
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, Window)] -> Invisible [] (SomeMessage, Window)
forall (m :: * -> *) a. m a -> Invisible m a
I ([(SomeMessage, Window)] -> Invisible [] (SomeMessage, Window))
-> [(SomeMessage, Window)] -> Invisible [] (SomeMessage, Window)
forall a b. (a -> b) -> a -> b
$ [(SomeMessage, Window)]
ms' [(SomeMessage, Window)]
-> [(SomeMessage, Window)] -> [(SomeMessage, Window)]
forall a. [a] -> [a] -> [a]
++ [(SomeMessage, Window)]
ms) ([Int], l Window)
defl [(l Window, Stack Window)]
sls

        | Just UpdateBoring
B.UpdateBoring <- SomeMessage -> Maybe UpdateBoring
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
            let bs :: [Window]
bs = (Stack Window -> [Window]) -> [Stack Window] -> [Window]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stack Window -> [Window]
forall a. Stack a -> [a]
unfocused ([Stack Window] -> [Window]) -> [Stack Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Groups Window -> [Stack Window]
forall k a. Map k a -> [a]
M.elems Groups Window
gs
            Workspace String (Layout Window) Window
ws <- (XState -> Workspace String (Layout Window) Window)
-> X (Workspace String (Layout Window) Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
            (BoringMessage -> Workspace String (Layout Window) Window -> X ())
-> Workspace String (Layout Window) Window -> BoringMessage -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip BoringMessage -> Workspace String (Layout Window) Window -> X ()
forall a.
Message a =>
a -> Workspace String (Layout Window) Window -> X ()
sendMessageWithNoRefresh Workspace String (Layout Window) Window
ws (BoringMessage -> X ()) -> BoringMessage -> X ()
forall a b. (a -> b) -> a -> b
$ String -> [Window] -> BoringMessage
B.Replace String
"Sublayouts" [Window]
bs
            Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Sublayout l Window)
forall a. Maybe a
Nothing

        | Just (WithGroup Stack Window -> X (Stack Window)
f Window
w) <- SomeMessage -> Maybe (GroupMsg Window)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
        , Just Stack Window
g <- Window -> Groups Window -> Maybe (Stack Window)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w Groups Window
gs = do
            Stack Window
g' <- Stack Window -> X (Stack Window)
f Stack Window
g
            let gs' :: Groups Window
gs' = Window -> Stack Window -> Groups Window -> Groups Window
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
g') Stack Window
g' (Groups Window -> Groups Window) -> Groups Window -> Groups Window
forall a b. (a -> b) -> a -> b
$ Window -> Groups Window -> Groups Window
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
g) Groups Window
gs
            Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Groups Window
gs' Groups Window -> Groups Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Groups Window
gs) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ Groups Window -> X ()
updateWs Groups Window
gs'
            Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
w Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
g') (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows (Window
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
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 (Window
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> Window
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
g')
            Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Sublayout l Window)
forall a. Maybe a
Nothing

        | Just (MergeAll Window
w) <- SomeMessage -> Maybe (GroupMsg Window)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            let gs' :: Maybe (Groups Window)
gs' = (Stack Window -> Groups Window)
-> Maybe (Stack Window) -> Maybe (Groups Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Window -> Stack Window -> Groups Window
forall k a. k -> a -> Map k a
M.singleton Window
w)
                    (Maybe (Stack Window) -> Maybe (Groups Window))
-> Maybe (Stack Window) -> Maybe (Groups Window)
forall a b. (a -> b) -> a -> b
$ (Window -> Stack Window -> Maybe (Stack Window)
forall a. Eq a => a -> Stack a -> Maybe (Stack a)
focusWindow' Window
w (Stack Window -> Maybe (Stack Window))
-> Maybe (Stack Window) -> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe (Stack Window) -> Maybe (Stack Window))
-> Maybe (Stack Window) -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ [Window] -> Maybe (Stack Window)
forall a. [a] -> Maybe (Stack a)
W.differentiate
                    ([Window] -> Maybe (Stack Window))
-> [Window] -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ (Stack Window -> [Window]) -> [Stack Window] -> [Window]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate ([Stack Window] -> [Window]) -> [Stack Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Groups Window -> [Stack Window]
forall k a. Map k a -> [a]
M.elems Groups Window
gs
            in X (Maybe (Sublayout l Window))
-> (Groups Window -> X (Maybe (Sublayout l Window)))
-> Maybe (Groups Window)
-> X (Maybe (Sublayout l Window))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Sublayout l Window)
forall a. Maybe a
Nothing) Groups Window -> X (Maybe (Sublayout l Window))
fgs Maybe (Groups Window)
gs'

        | Just (UnMergeAll Window
w) <- SomeMessage -> Maybe (GroupMsg Window)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            let ws :: [Window]
ws = (Stack Window -> [Window]) -> [Stack Window] -> [Window]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate ([Stack Window] -> [Window]) -> [Stack Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Groups Window -> [Stack Window]
forall k a. Map k a -> [a]
M.elems Groups Window
gs
                Window
_ = Window
w :: Window
                mkSingleton :: a -> Map a (Stack a)
mkSingleton a
f = a -> Stack a -> Map a (Stack a)
forall k a. k -> a -> Map k a
M.singleton a
f (a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [] [])
            in Groups Window -> X (Maybe (Sublayout l Window))
fgs (Groups Window -> X (Maybe (Sublayout l Window)))
-> Groups Window -> X (Maybe (Sublayout l Window))
forall a b. (a -> b) -> a -> b
$ [Groups Window] -> Groups Window
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Groups Window] -> Groups Window)
-> [Groups Window] -> Groups Window
forall a b. (a -> b) -> a -> b
$ (Window -> Groups Window) -> [Window] -> [Groups Window]
forall a b. (a -> b) -> [a] -> [b]
map Window -> Groups Window
forall {a}. a -> Map a (Stack a)
mkSingleton [Window]
ws

        | Just (Merge Window
x Window
y) <- SomeMessage -> Maybe (GroupMsg Window)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
        , Just (W.Stack Window
_ [Window]
xb [Window]
xn) <- Window -> Maybe (Stack Window)
findGroup Window
x
        , Just Stack Window
yst <- Window -> Maybe (Stack Window)
findGroup Window
y =
            let zs :: Stack Window
zs = Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x [Window]
xb ([Window]
xn [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Stack Window
yst)
            in Groups Window -> X (Maybe (Sublayout l Window))
fgs (Groups Window -> X (Maybe (Sublayout l Window)))
-> Groups Window -> X (Maybe (Sublayout l Window))
forall a b. (a -> b) -> a -> b
$ Window -> Stack Window -> Groups Window -> Groups Window
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
x Stack Window
zs (Groups Window -> Groups Window) -> Groups Window -> Groups Window
forall a b. (a -> b) -> a -> b
$ Window -> Groups Window -> Groups Window
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
yst) Groups Window
gs

        | Just (UnMerge Window
x) <- SomeMessage -> Maybe (GroupMsg Window)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Groups Window -> X (Maybe (Sublayout l Window))
fgs (Groups Window -> X (Maybe (Sublayout l Window)))
-> (Groups Window -> Groups Window)
-> Groups Window
-> X (Maybe (Sublayout l Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Window, Stack Window)] -> Groups Window
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Window, Stack Window)] -> Groups Window)
-> (Groups Window -> [(Window, Stack Window)])
-> Groups Window
-> Groups Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack Window -> (Window, Stack Window))
-> [Stack Window] -> [(Window, Stack Window)]
forall a b. (a -> b) -> [a] -> [b]
map (Stack Window -> Window
forall a. Stack a -> a
W.focus (Stack Window -> Window)
-> (Stack Window -> Stack Window)
-> Stack Window
-> (Window, Stack Window)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Stack Window -> Stack Window
forall a. a -> a
id) ([Stack Window] -> [(Window, Stack Window)])
-> (Groups Window -> [Stack Window])
-> Groups Window
-> [(Window, Stack Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Groups Window -> [Stack Window]
forall k a. Map k a -> [a]
M.elems
                    (Groups Window -> X (Maybe (Sublayout l Window)))
-> Groups Window -> X (Maybe (Sublayout l Window))
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Maybe (Stack Window))
-> Groups Window -> Groups Window
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe ((Window -> Bool) -> Stack Window -> Maybe (Stack Window)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (Window
xWindow -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/=)) Groups Window
gs

        -- XXX sometimes this migrates an incorrect window, why?
        | Just (Migrate Window
x Window
y) <- SomeMessage -> Maybe (GroupMsg Window)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
        , Just Stack Window
xst <- Window -> Maybe (Stack Window)
findGroup Window
x
        , Just (W.Stack Window
yf [Window]
yu [Window]
yd) <- Window -> Maybe (Stack Window)
findGroup Window
y =
            let zs :: Stack Window
zs = Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
x (Window
yfWindow -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:[Window]
yu) [Window]
yd
                nxsAdd :: Groups Window -> Groups Window
nxsAdd = (Groups Window -> Groups Window)
-> (Stack Window -> Groups Window -> Groups Window)
-> Maybe (Stack Window)
-> Groups Window
-> Groups Window
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Groups Window -> Groups Window
forall a. a -> a
id (\Stack Window
e -> Window -> Stack Window -> Groups Window -> Groups Window
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
e) Stack Window
e) (Maybe (Stack Window) -> Groups Window -> Groups Window)
-> Maybe (Stack Window) -> Groups Window -> Groups Window
forall a b. (a -> b) -> a -> b
$ (Window -> Bool) -> Stack Window -> Maybe (Stack Window)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (Window
xWindow -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/=) Stack Window
xst
            in Groups Window -> X (Maybe (Sublayout l Window))
fgs (Groups Window -> X (Maybe (Sublayout l Window)))
-> Groups Window -> X (Maybe (Sublayout l Window))
forall a b. (a -> b) -> a -> b
$ Groups Window -> Groups Window
nxsAdd (Groups Window -> Groups Window) -> Groups Window -> Groups Window
forall a b. (a -> b) -> a -> b
$ Window -> Stack Window -> Groups Window -> Groups Window
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
x Stack Window
zs (Groups Window -> Groups Window) -> Groups Window -> Groups Window
forall a b. (a -> b) -> a -> b
$ Window -> Groups Window -> Groups Window
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Window
yf Groups Window
gs


        | Bool
otherwise = Maybe (Maybe (Sublayout l Window)) -> Maybe (Sublayout l Window)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (Sublayout l Window)) -> Maybe (Sublayout l Window))
-> X (Maybe (Maybe (Sublayout l Window)))
-> X (Maybe (Sublayout l Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LayoutMessages -> X (Maybe (Sublayout l Window)))
-> Maybe LayoutMessages -> X (Maybe (Maybe (Sublayout l Window)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse LayoutMessages -> X (Maybe (Sublayout l Window))
catchLayoutMess (SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
     where gs :: Groups Window
gs = [(l Window, Stack Window)] -> Groups Window
forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(l Window, Stack Window)]
sls
           fgs :: Groups Window -> X (Maybe (Sublayout l Window))
fgs Groups Window
gs' = do
                Maybe (Stack Window)
st <- X (Maybe (Stack Window))
currentStack
                Sublayout l Window -> Maybe (Sublayout l Window)
forall a. a -> Maybe a
Just (Sublayout l Window -> Maybe (Sublayout l Window))
-> ([(Bool, (l Window, Stack Window))] -> Sublayout l Window)
-> [(Bool, (l Window, Stack Window))]
-> Maybe (Sublayout l Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Invisible [] (SomeMessage, Window)
-> ([Int], l Window)
-> [(l Window, Stack Window)]
-> Sublayout l Window
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, Window)] -> Invisible [] (SomeMessage, Window)
forall (m :: * -> *) a. m a -> Invisible m a
I [(SomeMessage, Window)]
ms) ([Int], l Window)
defl ([(l Window, Stack Window)] -> Sublayout l Window)
-> ([(Bool, (l Window, Stack Window))]
    -> [(l Window, Stack Window)])
-> [(Bool, (l Window, Stack Window))]
-> Sublayout l Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, (l Window, Stack Window)) -> (l Window, Stack Window))
-> [(Bool, (l Window, Stack Window))] -> [(l Window, Stack Window)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, (l Window, Stack Window)) -> (l Window, Stack Window)
forall a b. (a, b) -> b
snd ([(Bool, (l Window, Stack Window))] -> Maybe (Sublayout l Window))
-> X [(Bool, (l Window, Stack Window))]
-> X (Maybe (Sublayout l Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Int], l Window)
-> Maybe (Stack Window)
-> Groups Window
-> [(l Window, Stack Window)]
-> X [(Bool, (l Window, Stack Window))]
forall (layout :: * -> *) a k b.
(LayoutClass layout a, Ord k) =>
([Int], layout a)
-> Maybe (Stack k)
-> Groups k
-> [(layout a, b)]
-> X [(Bool, (layout a, Stack k))]
fromGroups ([Int], l Window)
defl Maybe (Stack Window)
st Groups Window
gs' [(l Window, Stack Window)]
sls

           findGroup :: Window -> Maybe (Stack Window)
findGroup Window
z = Maybe (Stack Window)
-> Maybe (Stack Window) -> Maybe (Stack Window)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (Window -> Groups Window -> Maybe (Stack Window)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
z Groups Window
gs) (Maybe (Stack Window) -> Maybe (Stack Window))
-> Maybe (Stack Window) -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ [Stack Window] -> Maybe (Stack Window)
forall a. [a] -> Maybe a
listToMaybe
                    ([Stack Window] -> Maybe (Stack Window))
-> [Stack Window] -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ Groups Window -> [Stack Window]
forall k a. Map k a -> [a]
M.elems (Groups Window -> [Stack Window])
-> Groups Window -> [Stack Window]
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Bool) -> Groups Window -> Groups Window
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter ((Window
z Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([Window] -> Bool)
-> (Stack Window -> [Window]) -> Stack Window -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate) Groups Window
gs

           catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window))
           catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window))
catchLayoutMess LayoutMessages
x = do
            let m' :: LayoutMessages
m' = LayoutMessages
x LayoutMessages -> LayoutMessages -> LayoutMessages
forall a. a -> a -> a
`asTypeOf` (LayoutMessages
forall a. HasCallStack => a
undefined :: LayoutMessages)
            [(SomeMessage, Window)]
ms' <- [SomeMessage] -> [Window] -> [(SomeMessage, Window)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SomeMessage -> [SomeMessage]
forall a. a -> [a]
repeat (SomeMessage -> [SomeMessage]) -> SomeMessage -> [SomeMessage]
forall a b. (a -> b) -> a -> b
$ LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
m') ([Window] -> [(SomeMessage, Window)])
-> (Maybe (Stack Window) -> [Window])
-> Maybe (Stack Window)
-> [(SomeMessage, Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate'
                    (Maybe (Stack Window) -> [(SomeMessage, Window)])
-> X (Maybe (Stack Window)) -> X [(SomeMessage, Window)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (Maybe (Stack Window))
currentStack
            Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window)))
-> Maybe (Sublayout l Window) -> X (Maybe (Sublayout l Window))
forall a b. (a -> b) -> a -> b
$ do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(SomeMessage, Window)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SomeMessage, Window)]
ms'
                        Sublayout l Window -> Maybe (Sublayout l Window)
forall a. a -> Maybe a
Just (Sublayout l Window -> Maybe (Sublayout l Window))
-> Sublayout l Window -> Maybe (Sublayout l Window)
forall a b. (a -> b) -> a -> b
$ Invisible [] (SomeMessage, Window)
-> ([Int], l Window)
-> [(l Window, Stack Window)]
-> Sublayout l Window
forall (l :: * -> *) a.
Invisible [] (SomeMessage, a)
-> ([Int], l a) -> [(l a, Stack a)] -> Sublayout l a
Sublayout ([(SomeMessage, Window)] -> Invisible [] (SomeMessage, Window)
forall (m :: * -> *) a. m a -> Invisible m a
I ([(SomeMessage, Window)] -> Invisible [] (SomeMessage, Window))
-> [(SomeMessage, Window)] -> Invisible [] (SomeMessage, Window)
forall a b. (a -> b) -> a -> b
$ [(SomeMessage, Window)]
ms' [(SomeMessage, Window)]
-> [(SomeMessage, Window)] -> [(SomeMessage, Window)]
forall a. [a] -> [a] -> [a]
++ [(SomeMessage, Window)]
ms) ([Int], l Window)
defl [(l Window, Stack Window)]
sls

currentStack :: X (Maybe (W.Stack Window))
currentStack :: X (Maybe (Stack Window))
currentStack = (XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)

-- | update Group to follow changes in the workspace
updateGroup :: Ord a => Maybe (W.Stack a) -> Groups a -> Groups a
updateGroup :: forall a. Ord a => Maybe (Stack a) -> Groups a -> Groups a
updateGroup Maybe (Stack a)
Nothing Groups a
_ = Groups a
forall a. Monoid a => a
mempty
updateGroup (Just Stack a
st) Groups a
gs = GroupStack a -> Groups a
forall a. Ord a => GroupStack a -> Groups a
fromGroupStack (Groups a -> Stack a -> GroupStack a
forall a. Ord a => Groups a -> Stack a -> GroupStack a
toGroupStack Groups a
gs Stack a
st)

-- | rearrange the windowset to put the groups of tabs next to each other, so
-- that the stack of tabs stays put.
updateWs :: Groups Window -> X ()
updateWs :: Groups Window -> X ()
updateWs = (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe
      (StackSet String (Layout Window) Window ScreenId ScreenDetail))
-> X ()
windowsMaybe ((StackSet String (Layout Window) Window ScreenId ScreenDetail
  -> Maybe
       (StackSet String (Layout Window) Window ScreenId ScreenDetail))
 -> X ())
-> (Groups Window
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe
         (StackSet String (Layout Window) Window ScreenId ScreenDetail))
-> Groups Window
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Groups Window
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
updateWs'

updateWs' :: Groups Window -> WindowSet -> Maybe WindowSet
updateWs' :: Groups Window
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
updateWs' Groups Window
gs StackSet String (Layout Window) Window ScreenId ScreenDetail
ws = do
    Stack Window
w <- Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe (Stack Window))
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
ws
    let w' :: Stack Window
w' = GroupStack Window -> Stack Window
forall a. GroupStack a -> Stack a
flattenGroupStack (GroupStack Window -> Stack Window)
-> (Stack Window -> GroupStack Window)
-> Stack Window
-> Stack Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Groups Window -> Stack Window -> GroupStack Window
forall a. Ord a => Groups a -> Stack a -> GroupStack a
toGroupStack Groups Window
gs (Stack Window -> Stack Window) -> Stack Window -> Stack Window
forall a b. (a -> b) -> a -> b
$ Stack Window
w
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Stack Window
w Stack Window -> Stack Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Stack Window
w'
    StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe
      (StackSet String (Layout Window) Window ScreenId ScreenDetail))
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' (Stack Window -> Stack Window -> Stack Window
forall a b. a -> b -> a
const Stack Window
w') StackSet String (Layout Window) Window ScreenId ScreenDetail
ws

-- | Flatten a stack of stacks.
flattenGroupStack :: GroupStack a -> W.Stack a
flattenGroupStack :: forall a. GroupStack a -> Stack a
flattenGroupStack (W.Stack (W.Stack a
f [a]
lf [a]
rf) [Stack a]
ls [Stack a]
rs) =
    let l :: [a]
l = [a]
lf [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (Stack a -> [a]) -> [Stack a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (Stack a -> [a]) -> Stack a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> [a]
forall a. Stack a -> [a]
W.integrate) [Stack a]
ls
        r :: [a]
r = [a]
rf [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (Stack a -> [a]) -> [Stack a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stack a -> [a]
forall a. Stack a -> [a]
W.integrate [Stack a]
rs
    in a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [a]
l [a]
r

-- | Extract Groups from a stack of stacks.
fromGroupStack :: (Ord a) => GroupStack a -> Groups a
fromGroupStack :: forall a. Ord a => GroupStack a -> Groups a
fromGroupStack = [(a, Stack a)] -> Map a (Stack a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, Stack a)] -> Map a (Stack a))
-> (Stack (Stack a) -> [(a, Stack a)])
-> Stack (Stack a)
-> Map a (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> (a, Stack a)) -> [Stack a] -> [(a, Stack a)]
forall a b. (a -> b) -> [a] -> [b]
map (Stack a -> a
forall a. Stack a -> a
W.focus (Stack a -> a) -> (Stack a -> Stack a) -> Stack a -> (a, Stack a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Stack a -> Stack a
forall a. a -> a
id) ([Stack a] -> [(a, Stack a)])
-> (Stack (Stack a) -> [Stack a])
-> Stack (Stack a)
-> [(a, Stack a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Stack a) -> [Stack a]
forall a. Stack a -> [a]
W.integrate

-- | Arrange a stack of windows into a stack of stacks, according to (possibly
-- outdated) Groups.
--
-- Assumes that the groups are disjoint and there are no duplicates in the
-- stack; will result in additional duplicates otherwise. This is a reasonable
-- assumption—the rest of xmonad will mishave too—but it isn't checked
-- anywhere and there had been bugs breaking this assumption in the past.
toGroupStack :: (Ord a) => Groups a -> W.Stack a -> GroupStack a
toGroupStack :: forall a. Ord a => Groups a -> Stack a -> GroupStack a
toGroupStack Groups a
gs st :: Stack a
st@(W.Stack a
f [a]
ls [a]
rs) =
    Stack a -> [Stack a] -> [Stack a] -> Stack (Stack a)
forall a. a -> [a] -> [a] -> Stack a
W.Stack (Maybe (Stack a) -> Stack a
forall a. HasCallStack => Maybe a -> a
fromJust (a -> Maybe (Stack a)
lu a
f)) ((a -> Maybe (Stack a)) -> [a] -> [Stack a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe (Stack a)
lu [a]
ls) ((a -> Maybe (Stack a)) -> [a] -> [Stack a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe (Stack a)
lu [a]
rs)
  where
    wset :: Set a
wset = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList (Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
st)
    dead :: Stack a -> Maybe (Stack a)
dead = (a -> Bool) -> Stack a -> Maybe (Stack a)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
wset) -- drop dead windows or entire groups
    refocus :: Stack a -> Maybe (Stack a)
refocus Stack a
s | a
f a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
s -- sync focus/order of current group
                                       = (a -> Bool) -> Stack a -> Maybe (Stack a)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
s) Stack a
st
              | Bool
otherwise = Stack a -> Maybe (Stack a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stack a
s
    gs' :: Groups a
gs' = (Stack a -> Maybe (Stack a)) -> Groups a -> Groups a
forall a.
Ord a =>
(Stack a -> Maybe (Stack a)) -> Groups a -> Groups a
mapGroups (Stack a -> Maybe (Stack a)
refocus (Stack a -> Maybe (Stack a))
-> (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Stack a -> Maybe (Stack a)
dead) Groups a
gs
    gset :: Set a
gset = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> (Groups a -> [a]) -> Groups a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> [a]) -> [Stack a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stack a -> [a]
forall a. Stack a -> [a]
W.integrate ([Stack a] -> [a]) -> (Groups a -> [Stack a]) -> Groups a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Groups a -> [Stack a]
forall k a. Map k a -> [a]
M.elems (Groups a -> Set a) -> Groups a -> Set a
forall a b. (a -> b) -> a -> b
$ Groups a
gs'
    -- after refocus, f is either the focused window of some group, or not in
    -- gs' at all, so `lu f` is never Nothing
    lu :: a -> Maybe (Stack a)
lu a
w | a
w a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
gset = a
w a -> Groups a -> Maybe (Stack a)
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Groups a
gs'
         | Bool
otherwise = Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
w [] []) -- singleton groups for new wins

mapGroups :: (Ord a) => (W.Stack a -> Maybe (W.Stack a)) -> Groups a -> Groups a
mapGroups :: forall a.
Ord a =>
(Stack a -> Maybe (Stack a)) -> Groups a -> Groups a
mapGroups Stack a -> Maybe (Stack a)
f = [(a, Stack a)] -> Map a (Stack a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, Stack a)] -> Map a (Stack a))
-> (Map a (Stack a) -> [(a, Stack a)])
-> Map a (Stack a)
-> Map a (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> (a, Stack a)) -> [Stack a] -> [(a, Stack a)]
forall a b. (a -> b) -> [a] -> [b]
map (Stack a -> a
forall a. Stack a -> a
W.focus (Stack a -> a) -> (Stack a -> Stack a) -> Stack a -> (a, Stack a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Stack a -> Stack a
forall a. a -> a
id) ([Stack a] -> [(a, Stack a)])
-> (Map a (Stack a) -> [Stack a])
-> Map a (Stack a)
-> [(a, Stack a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> Maybe (Stack a)) -> [Stack a] -> [Stack a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Stack a -> Maybe (Stack a)
f ([Stack a] -> [Stack a])
-> (Map a (Stack a) -> [Stack a]) -> Map a (Stack a) -> [Stack a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Stack a) -> [Stack a]
forall k a. Map k a -> [a]
M.elems

-- | focusWindow'. focus an element of a stack, is Nothing if that element is
-- absent. See also 'W.focusWindow'
focusWindow' :: (Eq a) => a -> W.Stack a -> Maybe (W.Stack a)
focusWindow' :: forall a. Eq a => a -> Stack a -> Maybe (Stack a)
focusWindow' a
w Stack a
st = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ a
w a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
st
    Stack a -> Maybe (Stack a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ (Stack a -> Bool) -> (Stack a -> Stack a) -> Stack a -> Stack a
forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) (a -> Bool) -> (Stack a -> a) -> Stack a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> a
forall a. Stack a -> a
W.focus) Stack a -> Stack a
forall a. Stack a -> Stack a
W.focusDown' Stack a
st

-- update only when Just
windowsMaybe :: (WindowSet -> Maybe WindowSet) -> X ()
windowsMaybe :: (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe
      (StackSet String (Layout Window) Window ScreenId ScreenDetail))
-> X ()
windowsMaybe StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
f = do
    XState
xst <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
    StackSet String (Layout Window) Window ScreenId ScreenDetail
ws <- (XState
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
    let up :: StackSet String (Layout Window) Window ScreenId ScreenDetail
-> m ()
up StackSet String (Layout Window) Window ScreenId ScreenDetail
fws = XState -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
xst { windowset :: StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset = StackSet String (Layout Window) Window ScreenId ScreenDetail
fws }
    X ()
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> X ())
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) StackSet String (Layout Window) Window ScreenId ScreenDetail
-> X ()
forall {m :: * -> *}.
MonadState XState m =>
StackSet String (Layout Window) Window ScreenId ScreenDetail
-> m ()
up (Maybe
   (StackSet String (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
f StackSet String (Layout Window) Window ScreenId ScreenDetail
ws

unfocused :: W.Stack a -> [a]
unfocused :: forall a. Stack a -> [a]
unfocused Stack a
x = Stack a -> [a]
forall a. Stack a -> [a]
W.up Stack a
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Stack a -> [a]
forall a. Stack a -> [a]
W.down Stack a
x

toGroups :: (Ord a) => [(a1, W.Stack a)] -> Map a (W.Stack a)
toGroups :: forall a a1. Ord a => [(a1, Stack a)] -> Map a (Stack a)
toGroups [(a1, Stack a)]
ws = [(a, Stack a)] -> Map a (Stack a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, Stack a)] -> Map a (Stack a))
-> ([Stack a] -> [(a, Stack a)]) -> [Stack a] -> Map a (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> (a, Stack a)) -> [Stack a] -> [(a, Stack a)]
forall a b. (a -> b) -> [a] -> [b]
map (Stack a -> a
forall a. Stack a -> a
W.focus (Stack a -> a) -> (Stack a -> Stack a) -> Stack a -> (a, Stack a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Stack a -> Stack a
forall a. a -> a
id) ([Stack a] -> [(a, Stack a)])
-> ([Stack a] -> [Stack a]) -> [Stack a] -> [(a, Stack a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> Stack a -> Bool) -> [Stack a] -> [Stack a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ((a -> a -> Bool) -> (Stack a -> a) -> Stack a -> Stack a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Stack a -> a
forall a. Stack a -> a
W.focus)
                    ([Stack a] -> Map a (Stack a)) -> [Stack a] -> Map a (Stack a)
forall a b. (a -> b) -> a -> b
$ ((a1, Stack a) -> Stack a) -> [(a1, Stack a)] -> [Stack a]
forall a b. (a -> b) -> [a] -> [b]
map (a1, Stack a) -> Stack a
forall a b. (a, b) -> b
snd [(a1, Stack a)]
ws

-- | restore the default layout for each group. It needs the X monad to switch
-- the default layout to a specific one (handleMessage NextLayout)
fromGroups :: (LayoutClass layout a, Ord k) =>
              ([Int], layout a)
              -> Maybe (W.Stack k)
              -> Groups k
              -> [(layout a, b)]
              -> X [(Bool,(layout a, W.Stack k))]
fromGroups :: forall (layout :: * -> *) a k b.
(LayoutClass layout a, Ord k) =>
([Int], layout a)
-> Maybe (Stack k)
-> Groups k
-> [(layout a, b)]
-> X [(Bool, (layout a, Stack k))]
fromGroups ([Int]
skips,layout a
defl) Maybe (Stack k)
st Groups k
gs [(layout a, b)]
sls = do
    [layout a]
defls <- (Int -> X (layout a)) -> [Int] -> X [layout a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((layout a -> X (layout a)) -> layout a -> [X (layout a)]
forall {m :: * -> *} {a}. Monad m => (a -> m a) -> a -> [m a]
iterateM layout a -> X (layout a)
forall {layout :: * -> *} {a}.
LayoutClass layout a =>
layout a -> X (layout a)
nextL layout a
defl [X (layout a)] -> Int -> X (layout a)
forall a. [a] -> Int -> a
!!) [Int]
skips
    [(Bool, (layout a, Stack k))] -> X [(Bool, (layout a, Stack k))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Bool, (layout a, Stack k))] -> X [(Bool, (layout a, Stack k))])
-> [(Bool, (layout a, Stack k))] -> X [(Bool, (layout a, Stack k))]
forall a b. (a -> b) -> a -> b
$ layout a
-> [layout a]
-> Maybe (Stack k)
-> Groups k
-> [layout a]
-> [(Bool, (layout a, Stack k))]
forall k a.
Ord k =>
a
-> [a]
-> Maybe (Stack k)
-> Groups k
-> [a]
-> [(Bool, (a, Stack k))]
fromGroups' layout a
defl [layout a]
defls Maybe (Stack k)
st Groups k
gs (((layout a, b) -> layout a) -> [(layout a, b)] -> [layout a]
forall a b. (a -> b) -> [a] -> [b]
map (layout a, b) -> layout a
forall a b. (a, b) -> a
fst [(layout a, b)]
sls)
        where nextL :: layout a -> X (layout a)
nextL layout a
l = layout a -> Maybe (layout a) -> layout a
forall a. a -> Maybe a -> a
fromMaybe layout a
l (Maybe (layout a) -> layout a)
-> X (Maybe (layout a)) -> X (layout a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> layout a -> SomeMessage -> X (Maybe (layout a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage layout a
l (ChangeLayout -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage ChangeLayout
NextLayout)
              iterateM :: (a -> m a) -> a -> [m a]
iterateM a -> m a
f = (m a -> m a) -> m a -> [m a]
forall a. (a -> a) -> a -> [a]
iterate (m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
f) (m a -> [m a]) -> (a -> m a) -> a -> [m a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

fromGroups' :: (Ord k) => a -> [a] -> Maybe (W.Stack k) -> Groups k -> [a]
                    -> [(Bool,(a, W.Stack k))]
fromGroups' :: forall k a.
Ord k =>
a
-> [a]
-> Maybe (Stack k)
-> Groups k
-> [a]
-> [(Bool, (a, Stack k))]
fromGroups' a
defl [a]
defls Maybe (Stack k)
st Groups k
gs [a]
sls =
    [ (Bool
isNew,(a, Stack k) -> (Maybe a, Maybe (Stack k)) -> (a, Stack k)
forall {a} {b}. (a, b) -> (Maybe a, Maybe b) -> (a, b)
fromMaybe2 (a
dl, k -> Stack k
forall {a}. a -> Stack a
single k
w) (Maybe a
l, k -> Groups k -> Maybe (Stack k)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
w Groups k
gs))
        | Maybe a
l <- (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
sls [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
forall a. Maybe a
Nothing, let isNew :: Bool
isNew = Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
l
        | a
dl <- [a]
defls [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> [a]
forall a. a -> [a]
repeat a
defl
        | k
w <- Maybe (Stack k) -> [k]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack k) -> [k]) -> Maybe (Stack k) -> [k]
forall a b. (a -> b) -> a -> b
$ (k -> Bool) -> Stack k -> Maybe (Stack k)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (k -> [k] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [k]
unfocs) (Stack k -> Maybe (Stack k)) -> Maybe (Stack k) -> Maybe (Stack k)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Stack k)
st ]
    where unfocs :: [k]
unfocs = Stack k -> [k]
forall a. Stack a -> [a]
unfocused (Stack k -> [k]) -> [Stack k] -> [k]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Groups k -> [Stack k]
forall k a. Map k a -> [a]
M.elems Groups k
gs
          single :: a -> Stack a
single a
w = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
w [] []
          fromMaybe2 :: (a, b) -> (Maybe a, Maybe b) -> (a, b)
fromMaybe2 (a
a,b
b) (Maybe a
x,Maybe b
y) = (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
a Maybe a
x, b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
b Maybe b
y)


-- this would be much cleaner with some kind of data-accessor
setStack :: Maybe (W.Stack Window) -> X ()
setStack :: Maybe (Stack Window) -> X ()
setStack Maybe (Stack Window)
x = (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s { windowset :: StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset = (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset XState
s)
                { current :: Screen String (Layout Window) Window ScreenId ScreenDetail
W.current = (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset XState
s)
                { workspace :: Workspace String (Layout Window) Window
W.workspace = (Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset XState
s) { stack :: Maybe (Stack Window)
W.stack = Maybe (Stack Window)
x }}}})