-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.DynamicWorkspaces
-- Description :  Provides bindings to add and delete workspaces.
-- Copyright   :  (c) David Roundy <droundy@darcs.net>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  none
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides bindings to add and delete workspaces.
--
-----------------------------------------------------------------------------

module XMonad.Actions.DynamicWorkspaces (
                                         -- * Usage
                                         -- $usage
                                         addWorkspace, addWorkspacePrompt,
                                         appendWorkspace, appendWorkspacePrompt,
                                         addWorkspaceAt,
                                         removeWorkspace,
                                         removeWorkspaceByTag,
                                         removeEmptyWorkspace,
                                         removeEmptyWorkspaceByTag,
                                         removeEmptyWorkspaceAfter,
                                         removeEmptyWorkspaceAfterExcept,
                                         addHiddenWorkspace, addHiddenWorkspaceAt,
                                         withWorkspace,
                                         selectWorkspace, renameWorkspace,
                                         renameWorkspaceByName,
                                         toNthWorkspace, withNthWorkspace,
                                         setWorkspaceIndex, withWorkspaceIndex,
                                         WorkspaceIndex
                                       ) where

import XMonad.Prelude (find, isNothing, nub, when)
import XMonad hiding (workspaces)
import XMonad.StackSet hiding (filter, modify, delete)
import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )
import XMonad.Prompt ( XPConfig, mkXPrompt )
import XMonad.Util.WorkspaceCompare ( getSortByIndex )
import qualified Data.Map.Strict as Map
import qualified XMonad.Util.ExtensibleState as XS

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.DynamicWorkspaces
-- > import XMonad.Actions.CopyWindow(copy)
--
-- Then add keybindings like the following:
--
-- >   , ((modm .|. shiftMask, xK_BackSpace), removeWorkspace)
-- >   , ((modm .|. shiftMask, xK_v      ), selectWorkspace def)
-- >   , ((modm, xK_m                    ), withWorkspace def (windows . W.shift))
-- >   , ((modm .|. shiftMask, xK_m      ), withWorkspace def (windows . copy))
-- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace def)
--
-- > -- mod-[1..9]       %! Switch to workspace N in the list of workspaces
-- > -- mod-shift-[1..9] %! Move client to workspace N in the list of workspaces
-- >    ++
-- >    zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
-- >    ++
-- >    zip (zip (repeat (modm .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])
--
-- Alternatively, you can associate indexes (which don't depend of the
-- workspace list order) to workspaces by using following keybindings:
--
-- > -- mod-[1..9]         %! Switch to workspace of index N
-- > -- mod-control-[1..9] %! Set index N to the current workspace
-- >    ++
-- >    zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withWorkspaceIndex W.greedyView) [1..])
-- >    ++
-- >    zip (zip (repeat (modm .|. controlMask)) [xK_1..xK_9]) (map (setWorkspaceIndex) [1..])
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for
-- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'.

type WorkspaceTag = String
-- | The workspace index is mapped to a workspace tag by the user and
-- can be updated.
type WorkspaceIndex  = Int

-- | Internal dynamic project state that stores a mapping between
--   workspace indexes and workspace tags.
newtype DynamicWorkspaceState = DynamicWorkspaceState {DynamicWorkspaceState -> Map WorkspaceIndex WorkspaceTag
workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
  deriving (ReadPrec [DynamicWorkspaceState]
ReadPrec DynamicWorkspaceState
WorkspaceIndex -> ReadS DynamicWorkspaceState
ReadS [DynamicWorkspaceState]
(WorkspaceIndex -> ReadS DynamicWorkspaceState)
-> ReadS [DynamicWorkspaceState]
-> ReadPrec DynamicWorkspaceState
-> ReadPrec [DynamicWorkspaceState]
-> Read DynamicWorkspaceState
forall a.
(WorkspaceIndex -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DynamicWorkspaceState]
$creadListPrec :: ReadPrec [DynamicWorkspaceState]
readPrec :: ReadPrec DynamicWorkspaceState
$creadPrec :: ReadPrec DynamicWorkspaceState
readList :: ReadS [DynamicWorkspaceState]
$creadList :: ReadS [DynamicWorkspaceState]
readsPrec :: WorkspaceIndex -> ReadS DynamicWorkspaceState
$creadsPrec :: WorkspaceIndex -> ReadS DynamicWorkspaceState
Read, WorkspaceIndex -> DynamicWorkspaceState -> ShowS
[DynamicWorkspaceState] -> ShowS
DynamicWorkspaceState -> WorkspaceTag
(WorkspaceIndex -> DynamicWorkspaceState -> ShowS)
-> (DynamicWorkspaceState -> WorkspaceTag)
-> ([DynamicWorkspaceState] -> ShowS)
-> Show DynamicWorkspaceState
forall a.
(WorkspaceIndex -> a -> ShowS)
-> (a -> WorkspaceTag) -> ([a] -> ShowS) -> Show a
showList :: [DynamicWorkspaceState] -> ShowS
$cshowList :: [DynamicWorkspaceState] -> ShowS
show :: DynamicWorkspaceState -> WorkspaceTag
$cshow :: DynamicWorkspaceState -> WorkspaceTag
showsPrec :: WorkspaceIndex -> DynamicWorkspaceState -> ShowS
$cshowsPrec :: WorkspaceIndex -> DynamicWorkspaceState -> ShowS
Show)

instance ExtensionClass DynamicWorkspaceState where
  initialValue :: DynamicWorkspaceState
initialValue = Map WorkspaceIndex WorkspaceTag -> DynamicWorkspaceState
DynamicWorkspaceState Map WorkspaceIndex WorkspaceTag
forall k a. Map k a
Map.empty
  extensionType :: DynamicWorkspaceState -> StateExtension
extensionType = DynamicWorkspaceState -> StateExtension
forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

-- | Set the index of the current workspace.
setWorkspaceIndex :: WorkspaceIndex -> X ()
setWorkspaceIndex :: WorkspaceIndex -> X ()
setWorkspaceIndex WorkspaceIndex
widx = do
  WorkspaceTag
wtag  <- (XState -> WorkspaceTag) -> X WorkspaceTag
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceTag
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceTag)
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset)
  Map WorkspaceIndex WorkspaceTag
wmap <- (DynamicWorkspaceState -> Map WorkspaceIndex WorkspaceTag)
-> X (Map WorkspaceIndex WorkspaceTag)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets DynamicWorkspaceState -> Map WorkspaceIndex WorkspaceTag
workspaceIndexMap
  (DynamicWorkspaceState -> DynamicWorkspaceState) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((DynamicWorkspaceState -> DynamicWorkspaceState) -> X ())
-> (DynamicWorkspaceState -> DynamicWorkspaceState) -> X ()
forall a b. (a -> b) -> a -> b
$ \DynamicWorkspaceState
s -> DynamicWorkspaceState
s {workspaceIndexMap :: Map WorkspaceIndex WorkspaceTag
workspaceIndexMap = WorkspaceIndex
-> WorkspaceTag
-> Map WorkspaceIndex WorkspaceTag
-> Map WorkspaceIndex WorkspaceTag
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert WorkspaceIndex
widx WorkspaceTag
wtag Map WorkspaceIndex WorkspaceTag
wmap}

withWorkspaceIndex :: (String -> WindowSet -> WindowSet) -> WorkspaceIndex -> X ()
withWorkspaceIndex :: (WorkspaceTag
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceIndex -> X ()
withWorkspaceIndex WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
job WorkspaceIndex
widx = do
  Maybe WorkspaceTag
wtag <- WorkspaceIndex -> X (Maybe WorkspaceTag)
ilookup WorkspaceIndex
widx
  X () -> (WorkspaceTag -> X ()) -> Maybe WorkspaceTag -> X ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet
    WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (WorkspaceTag
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceTag
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
job) Maybe WorkspaceTag
wtag
    where
      ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
      ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
ilookup WorkspaceIndex
idx = WorkspaceIndex
-> Map WorkspaceIndex WorkspaceTag -> Maybe WorkspaceTag
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceIndex
idx (Map WorkspaceIndex WorkspaceTag -> Maybe WorkspaceTag)
-> X (Map WorkspaceIndex WorkspaceTag) -> X (Maybe WorkspaceTag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DynamicWorkspaceState -> Map WorkspaceIndex WorkspaceTag)
-> X (Map WorkspaceIndex WorkspaceTag)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets DynamicWorkspaceState -> Map WorkspaceIndex WorkspaceTag
workspaceIndexMap


mkCompl :: [String] -> String -> IO [String]
mkCompl :: [WorkspaceTag] -> WorkspaceTag -> IO [WorkspaceTag]
mkCompl [WorkspaceTag]
l WorkspaceTag
s = [WorkspaceTag] -> IO [WorkspaceTag]
forall (m :: * -> *) a. Monad m => a -> m a
return ([WorkspaceTag] -> IO [WorkspaceTag])
-> [WorkspaceTag] -> IO [WorkspaceTag]
forall a b. (a -> b) -> a -> b
$ (WorkspaceTag -> Bool) -> [WorkspaceTag] -> [WorkspaceTag]
forall a. (a -> Bool) -> [a] -> [a]
filter (\WorkspaceTag
x -> WorkspaceIndex -> ShowS
forall a. WorkspaceIndex -> [a] -> [a]
take (WorkspaceTag -> WorkspaceIndex
forall (t :: * -> *) a. Foldable t => t a -> WorkspaceIndex
length WorkspaceTag
s) WorkspaceTag
x WorkspaceTag -> WorkspaceTag -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceTag
s) [WorkspaceTag]
l

withWorkspace :: XPConfig -> (String -> X ()) -> X ()
withWorkspace :: XPConfig -> (WorkspaceTag -> X ()) -> X ()
withWorkspace XPConfig
c WorkspaceTag -> X ()
job = do [Workspace WorkspaceTag (Layout Window) Window]
ws <- (XState -> [Workspace WorkspaceTag (Layout Window) Window])
-> X [Workspace WorkspaceTag (Layout Window) Window]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> [Workspace WorkspaceTag (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> [Workspace WorkspaceTag (Layout Window) Window])
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace WorkspaceTag (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset)
                         WorkspaceSort
sort <- X WorkspaceSort
getSortByIndex
                         let ts :: [WorkspaceTag]
ts = (Workspace WorkspaceTag (Layout Window) Window -> WorkspaceTag)
-> [Workspace WorkspaceTag (Layout Window) Window]
-> [WorkspaceTag]
forall a b. (a -> b) -> [a] -> [b]
map Workspace WorkspaceTag (Layout Window) Window -> WorkspaceTag
forall i l a. Workspace i l a -> i
tag ([Workspace WorkspaceTag (Layout Window) Window] -> [WorkspaceTag])
-> [Workspace WorkspaceTag (Layout Window) Window]
-> [WorkspaceTag]
forall a b. (a -> b) -> a -> b
$ WorkspaceSort
sort [Workspace WorkspaceTag (Layout Window) Window]
ws
                             job' :: WorkspaceTag -> X ()
job' WorkspaceTag
t | WorkspaceTag
t WorkspaceTag -> [WorkspaceTag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceTag]
ts = WorkspaceTag -> X ()
job WorkspaceTag
t
                                    | Bool
otherwise = WorkspaceTag -> X ()
addHiddenWorkspace WorkspaceTag
t X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WorkspaceTag -> X ()
job WorkspaceTag
t
                         Wor
-> XPConfig
-> (WorkspaceTag -> IO [WorkspaceTag])
-> (WorkspaceTag -> X ())
-> X ()
forall p.
XPrompt p =>
p
-> XPConfig
-> (WorkspaceTag -> IO [WorkspaceTag])
-> (WorkspaceTag -> X ())
-> X ()
mkXPrompt (WorkspaceTag -> Wor
Wor WorkspaceTag
"") XPConfig
c ([WorkspaceTag] -> WorkspaceTag -> IO [WorkspaceTag]
mkCompl [WorkspaceTag]
ts) WorkspaceTag -> X ()
job'

renameWorkspace :: XPConfig -> X ()
renameWorkspace :: XPConfig -> X ()
renameWorkspace XPConfig
conf = XPConfig -> (WorkspaceTag -> X ()) -> X ()
workspacePrompt XPConfig
conf WorkspaceTag -> X ()
renameWorkspaceByName

renameWorkspaceByName :: String -> X ()
renameWorkspaceByName :: WorkspaceTag -> X ()
renameWorkspaceByName WorkspaceTag
w = do WorkspaceTag
old  <- (XState -> WorkspaceTag) -> X WorkspaceTag
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceTag
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceTag)
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset)
                             (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet
    WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ \StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
s -> let sett :: Workspace i l a -> Workspace WorkspaceTag l a
sett Workspace i l a
wk = Workspace i l a
wk { tag :: WorkspaceTag
tag = WorkspaceTag
w }
                                                 setscr :: Screen i l a sid sd -> Screen WorkspaceTag l a sid sd
setscr Screen i l a sid sd
scr = Screen i l a sid sd
scr { workspace :: Workspace WorkspaceTag l a
workspace = Workspace i l a -> Workspace WorkspaceTag l a
forall i l a. Workspace i l a -> Workspace WorkspaceTag l a
sett (Workspace i l a -> Workspace WorkspaceTag l a)
-> Workspace i l a -> Workspace WorkspaceTag l a
forall a b. (a -> b) -> a -> b
$ Screen i l a sid sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace Screen i l a sid sd
scr }
                                                 sets :: StackSet WorkspaceTag l a sid sd
-> StackSet WorkspaceTag l a sid sd
sets StackSet WorkspaceTag l a sid sd
q = StackSet WorkspaceTag l a sid sd
q { current :: Screen WorkspaceTag l a sid sd
current = Screen WorkspaceTag l a sid sd -> Screen WorkspaceTag l a sid sd
forall i l a sid sd.
Screen i l a sid sd -> Screen WorkspaceTag l a sid sd
setscr (Screen WorkspaceTag l a sid sd -> Screen WorkspaceTag l a sid sd)
-> Screen WorkspaceTag l a sid sd -> Screen WorkspaceTag l a sid sd
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceTag l a sid sd -> Screen WorkspaceTag l a sid sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet WorkspaceTag l a sid sd
q }
                                             in StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
forall l a sid sd.
StackSet WorkspaceTag l a sid sd
-> StackSet WorkspaceTag l a sid sd
sets (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
forall i a l sid sd.
(Eq i, Eq a) =>
i -> StackSet i l a sid sd -> StackSet i l a sid sd
removeWorkspace' WorkspaceTag
w StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
s
                             WorkspaceTag -> WorkspaceTag -> X ()
forall (m :: * -> *).
XLike m =>
WorkspaceTag -> WorkspaceTag -> m ()
updateIndexMap WorkspaceTag
old WorkspaceTag
w
  where updateIndexMap :: WorkspaceTag -> WorkspaceTag -> m ()
updateIndexMap WorkspaceTag
oldIM WorkspaceTag
newIM = do
          Map WorkspaceIndex WorkspaceTag
wmap <- (DynamicWorkspaceState -> Map WorkspaceIndex WorkspaceTag)
-> m (Map WorkspaceIndex WorkspaceTag)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets DynamicWorkspaceState -> Map WorkspaceIndex WorkspaceTag
workspaceIndexMap
          (DynamicWorkspaceState -> DynamicWorkspaceState) -> m ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((DynamicWorkspaceState -> DynamicWorkspaceState) -> m ())
-> (DynamicWorkspaceState -> DynamicWorkspaceState) -> m ()
forall a b. (a -> b) -> a -> b
$ \DynamicWorkspaceState
s -> DynamicWorkspaceState
s {workspaceIndexMap :: Map WorkspaceIndex WorkspaceTag
workspaceIndexMap = ShowS
-> Map WorkspaceIndex WorkspaceTag
-> Map WorkspaceIndex WorkspaceTag
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\WorkspaceTag
t -> if WorkspaceTag
t WorkspaceTag -> WorkspaceTag -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceTag
oldIM then WorkspaceTag
newIM else WorkspaceTag
t) Map WorkspaceIndex WorkspaceTag
wmap}

toNthWorkspace :: (String -> X ()) -> Int -> X ()
toNthWorkspace :: (WorkspaceTag -> X ()) -> WorkspaceIndex -> X ()
toNthWorkspace WorkspaceTag -> X ()
job WorkspaceIndex
wnum = do WorkspaceSort
sort <- X WorkspaceSort
getSortByIndex
                             [WorkspaceTag]
ws <- (XState -> [WorkspaceTag]) -> X [WorkspaceTag]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Workspace WorkspaceTag (Layout Window) Window -> WorkspaceTag)
-> [Workspace WorkspaceTag (Layout Window) Window]
-> [WorkspaceTag]
forall a b. (a -> b) -> [a] -> [b]
map Workspace WorkspaceTag (Layout Window) Window -> WorkspaceTag
forall i l a. Workspace i l a -> i
tag ([Workspace WorkspaceTag (Layout Window) Window] -> [WorkspaceTag])
-> (XState -> [Workspace WorkspaceTag (Layout Window) Window])
-> XState
-> [WorkspaceTag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceSort
sort WorkspaceSort
-> (XState -> [Workspace WorkspaceTag (Layout Window) Window])
-> XState
-> [Workspace WorkspaceTag (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> [Workspace WorkspaceTag (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> [Workspace WorkspaceTag (Layout Window) Window])
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace WorkspaceTag (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset)
                             case WorkspaceIndex -> [WorkspaceTag] -> [WorkspaceTag]
forall a. WorkspaceIndex -> [a] -> [a]
drop WorkspaceIndex
wnum [WorkspaceTag]
ws of
                               (WorkspaceTag
w:[WorkspaceTag]
_) -> WorkspaceTag -> X ()
job WorkspaceTag
w
                               [] -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace :: (WorkspaceTag
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceIndex -> X ()
withNthWorkspace WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
job WorkspaceIndex
wnum = do WorkspaceSort
sort <- X WorkspaceSort
getSortByIndex
                               [WorkspaceTag]
ws <- (XState -> [WorkspaceTag]) -> X [WorkspaceTag]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Workspace WorkspaceTag (Layout Window) Window -> WorkspaceTag)
-> [Workspace WorkspaceTag (Layout Window) Window]
-> [WorkspaceTag]
forall a b. (a -> b) -> [a] -> [b]
map Workspace WorkspaceTag (Layout Window) Window -> WorkspaceTag
forall i l a. Workspace i l a -> i
tag ([Workspace WorkspaceTag (Layout Window) Window] -> [WorkspaceTag])
-> (XState -> [Workspace WorkspaceTag (Layout Window) Window])
-> XState
-> [WorkspaceTag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceSort
sort WorkspaceSort
-> (XState -> [Workspace WorkspaceTag (Layout Window) Window])
-> XState
-> [Workspace WorkspaceTag (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> [Workspace WorkspaceTag (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> [Workspace WorkspaceTag (Layout Window) Window])
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace WorkspaceTag (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset)
                               case WorkspaceIndex -> [WorkspaceTag] -> [WorkspaceTag]
forall a. WorkspaceIndex -> [a] -> [a]
drop WorkspaceIndex
wnum [WorkspaceTag]
ws of
                                 (WorkspaceTag
w:[WorkspaceTag]
_) -> (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet
    WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
job WorkspaceTag
w
                                 [] -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

selectWorkspace :: XPConfig -> X ()
selectWorkspace :: XPConfig -> X ()
selectWorkspace XPConfig
conf = XPConfig -> (WorkspaceTag -> X ()) -> X ()
workspacePrompt XPConfig
conf ((WorkspaceTag -> X ()) -> X ()) -> (WorkspaceTag -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WorkspaceTag
w ->
                       do StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
s <- (XState
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet
        WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset
                          if WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall i l a s sd. Eq i => i -> StackSet i l a s sd -> Bool
tagMember WorkspaceTag
w StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
s
                            then (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet
    WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView WorkspaceTag
w
                            else WorkspaceTag -> X ()
addWorkspace WorkspaceTag
w

-- | Add a new workspace with the given name, or do nothing if a
--   workspace with the given name already exists; then switch to the
--   newly created workspace.
addWorkspace :: String -> X ()
addWorkspace :: WorkspaceTag -> X ()
addWorkspace = (Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort)
-> WorkspaceTag -> X ()
addWorkspaceAt (:)

-- | Same as addWorkspace, but adds the workspace to the end of the list of workspaces
appendWorkspace :: String -> X()
appendWorkspace :: WorkspaceTag -> X ()
appendWorkspace = (Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort)
-> WorkspaceTag -> X ()
addWorkspaceAt (([Workspace WorkspaceTag (Layout Window) Window] -> WorkspaceSort)
-> [Workspace WorkspaceTag (Layout Window) Window] -> WorkspaceSort
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Workspace WorkspaceTag (Layout Window) Window] -> WorkspaceSort
forall a. [a] -> [a] -> [a]
(++) ([Workspace WorkspaceTag (Layout Window) Window] -> WorkspaceSort)
-> (Workspace WorkspaceTag (Layout Window) Window
    -> [Workspace WorkspaceTag (Layout Window) Window])
-> Workspace WorkspaceTag (Layout Window) Window
-> WorkspaceSort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceTag (Layout Window) Window
-> [Workspace WorkspaceTag (Layout Window) Window]
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | Adds a new workspace with the given name to the current list of workspaces.
--   This function allows the user to pass a function that inserts an element
--   into a list at an arbitrary spot.
addWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X ()
addWorkspaceAt :: (Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort)
-> WorkspaceTag -> X ()
addWorkspaceAt Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort
add WorkspaceTag
newtag = (Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort)
-> WorkspaceTag -> X ()
addHiddenWorkspaceAt Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort
add WorkspaceTag
newtag X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows (WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView WorkspaceTag
newtag)

-- | Prompt for the name of a new workspace, add it if it does not
--   already exist, and switch to it.
addWorkspacePrompt :: XPConfig -> X ()
addWorkspacePrompt :: XPConfig -> X ()
addWorkspacePrompt XPConfig
conf = Wor
-> XPConfig
-> (WorkspaceTag -> IO [WorkspaceTag])
-> (WorkspaceTag -> X ())
-> X ()
forall p.
XPrompt p =>
p
-> XPConfig
-> (WorkspaceTag -> IO [WorkspaceTag])
-> (WorkspaceTag -> X ())
-> X ()
mkXPrompt (WorkspaceTag -> Wor
Wor WorkspaceTag
"New workspace name: ") XPConfig
conf (IO [WorkspaceTag] -> WorkspaceTag -> IO [WorkspaceTag]
forall a b. a -> b -> a
const ([WorkspaceTag] -> IO [WorkspaceTag]
forall (m :: * -> *) a. Monad m => a -> m a
return [])) WorkspaceTag -> X ()
addWorkspace

-- | Prompt for the name of a new workspace, appending it to the end of the list of workspaces
--   if it does not already exist, and switch to it.
appendWorkspacePrompt :: XPConfig -> X ()
appendWorkspacePrompt :: XPConfig -> X ()
appendWorkspacePrompt XPConfig
conf = Wor
-> XPConfig
-> (WorkspaceTag -> IO [WorkspaceTag])
-> (WorkspaceTag -> X ())
-> X ()
forall p.
XPrompt p =>
p
-> XPConfig
-> (WorkspaceTag -> IO [WorkspaceTag])
-> (WorkspaceTag -> X ())
-> X ()
mkXPrompt (WorkspaceTag -> Wor
Wor WorkspaceTag
"New workspace name: ") XPConfig
conf (IO [WorkspaceTag] -> WorkspaceTag -> IO [WorkspaceTag]
forall a b. a -> b -> a
const ([WorkspaceTag] -> IO [WorkspaceTag]
forall (m :: * -> *) a. Monad m => a -> m a
return [])) WorkspaceTag -> X ()
appendWorkspace

-- | Add a new hidden workspace with the given name, or do nothing if
--   a workspace with the given name already exists. Takes a function to insert
--   the workspace at an arbitrary spot in the list.
addHiddenWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X ()
addHiddenWorkspaceAt :: (Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort)
-> WorkspaceTag -> X ()
addHiddenWorkspaceAt Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort
add WorkspaceTag
newtag =
  X Bool -> X () -> X ()
whenX ((XState -> Bool) -> X Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Bool -> Bool
not (Bool -> Bool) -> (XState -> Bool) -> XState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall i l a s sd. Eq i => i -> StackSet i l a s sd -> Bool
tagMember WorkspaceTag
newtag (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> Bool)
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    Layout Window
l <- (XConf -> Layout Window) -> X (Layout Window)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> Layout Window
forall (l :: * -> *). XConfig l -> l Window
layoutHook (XConfig Layout -> Layout Window)
-> (XConf -> XConfig Layout) -> XConf -> Layout Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
    (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort)
-> WorkspaceTag
-> Layout Window
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd.
(Workspace i l a -> [Workspace i l a] -> [Workspace i l a])
-> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
addHiddenWorkspace' Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort
add WorkspaceTag
newtag Layout Window
l)

-- | Add a new hidden workspace with the given name, or do nothing if
--   a workspace with the given name already exists.
addHiddenWorkspace :: String -> X ()
addHiddenWorkspace :: WorkspaceTag -> X ()
addHiddenWorkspace = (Workspace WorkspaceTag (Layout Window) Window -> WorkspaceSort)
-> WorkspaceTag -> X ()
addHiddenWorkspaceAt (:)

-- | Remove the current workspace if it contains no windows.
removeEmptyWorkspace :: X ()
removeEmptyWorkspace :: X ()
removeEmptyWorkspace = (XState -> WorkspaceTag) -> X WorkspaceTag
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceTag
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceTag)
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset) X WorkspaceTag -> (WorkspaceTag -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceTag -> X ()
removeEmptyWorkspaceByTag

-- | Remove the current workspace.
removeWorkspace :: X ()
removeWorkspace :: X ()
removeWorkspace = (XState -> WorkspaceTag) -> X WorkspaceTag
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceTag
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceTag)
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset) X WorkspaceTag -> (WorkspaceTag -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceTag -> X ()
removeWorkspaceByTag

-- | Remove workspace with specific tag if it contains no windows.
removeEmptyWorkspaceByTag :: String -> X ()
removeEmptyWorkspaceByTag :: WorkspaceTag -> X ()
removeEmptyWorkspaceByTag WorkspaceTag
t = X Bool -> X () -> X ()
whenX (WorkspaceTag -> X Bool
isEmpty WorkspaceTag
t) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceTag -> X ()
removeWorkspaceByTag WorkspaceTag
t

-- | Remove workspace with specific tag.
removeWorkspaceByTag :: String -> X ()
removeWorkspaceByTag :: WorkspaceTag -> X ()
removeWorkspaceByTag WorkspaceTag
torem = do
    StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
s <- (XState
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet
        WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset
    case StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
s of
        StackSet { current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current = Screen { workspace :: forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace = Workspace WorkspaceTag (Layout Window) Window
cur }, hidden :: forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
hidden = (Workspace WorkspaceTag (Layout Window) Window
w:[Workspace WorkspaceTag (Layout Window) Window]
_) } -> do
                Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WorkspaceTag
toremWorkspaceTag -> WorkspaceTag -> Bool
forall a. Eq a => a -> a -> Bool
==Workspace WorkspaceTag (Layout Window) Window -> WorkspaceTag
forall i l a. Workspace i l a -> i
tag Workspace WorkspaceTag (Layout Window) Window
cur) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet
    WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view (WorkspaceTag
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ Workspace WorkspaceTag (Layout Window) Window -> WorkspaceTag
forall i l a. Workspace i l a -> i
tag Workspace WorkspaceTag (Layout Window) Window
w
                (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet
    WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (StackSet
      WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceTag
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
forall i a l sid sd.
(Eq i, Eq a) =>
i -> StackSet i l a sid sd -> StackSet i l a sid sd
removeWorkspace' WorkspaceTag
torem
        StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
_ -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Remove the current workspace after an operation if it is empty and hidden.
--   Can be used to remove a workspace if it is empty when leaving it. The
--   operation may only change workspace once, otherwise the workspace will not
--   be removed.
removeEmptyWorkspaceAfter :: X () -> X ()
removeEmptyWorkspaceAfter :: X () -> X ()
removeEmptyWorkspaceAfter = [WorkspaceTag] -> X () -> X ()
removeEmptyWorkspaceAfterExcept []

-- | Like 'removeEmptyWorkspaceAfter' but use a list of sticky workspaces,
--   whose entries will never be removed.
removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X ()
removeEmptyWorkspaceAfterExcept :: [WorkspaceTag] -> X () -> X ()
removeEmptyWorkspaceAfterExcept [WorkspaceTag]
sticky X ()
f = do
    WorkspaceTag
before <- (XState -> WorkspaceTag) -> X WorkspaceTag
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceTag
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceTag)
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset)
    X ()
f
    WorkspaceTag
after <- (XState -> WorkspaceTag) -> X WorkspaceTag
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceTag
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceTag)
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset)
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WorkspaceTag
beforeWorkspaceTag -> WorkspaceTag -> Bool
forall a. Eq a => a -> a -> Bool
/=WorkspaceTag
after Bool -> Bool -> Bool
&& WorkspaceTag
before WorkspaceTag -> [WorkspaceTag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceTag]
sticky) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceTag -> X ()
removeEmptyWorkspaceByTag WorkspaceTag
before

isEmpty :: String -> X Bool
isEmpty :: WorkspaceTag -> X Bool
isEmpty WorkspaceTag
t = do [Workspace WorkspaceTag (Layout Window) Window]
wsl <- (XState -> [Workspace WorkspaceTag (Layout Window) Window])
-> X [Workspace WorkspaceTag (Layout Window) Window]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [Workspace WorkspaceTag (Layout Window) Window])
 -> X [Workspace WorkspaceTag (Layout Window) Window])
-> (XState -> [Workspace WorkspaceTag (Layout Window) Window])
-> X [Workspace WorkspaceTag (Layout Window) Window]
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
-> [Workspace WorkspaceTag (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces (StackSet WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
 -> [Workspace WorkspaceTag (Layout Window) Window])
-> (XState
    -> StackSet
         WorkspaceTag (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace WorkspaceTag (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceTag (Layout Window) Window ScreenId ScreenDetail
windowset
               let mws :: Maybe (Workspace WorkspaceTag (Layout Window) Window)
mws = (Workspace WorkspaceTag (Layout Window) Window -> Bool)
-> [Workspace WorkspaceTag (Layout Window) Window]
-> Maybe (Workspace WorkspaceTag (Layout Window) Window)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Workspace WorkspaceTag (Layout Window) Window
ws -> Workspace WorkspaceTag (Layout Window) Window -> WorkspaceTag
forall i l a. Workspace i l a -> i
tag Workspace WorkspaceTag (Layout Window) Window
ws WorkspaceTag -> WorkspaceTag -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceTag
t) [Workspace WorkspaceTag (Layout Window) Window]
wsl
               Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ Bool
-> (Workspace WorkspaceTag (Layout Window) Window -> Bool)
-> Maybe (Workspace WorkspaceTag (Layout Window) Window)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Maybe (Stack Window) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Stack Window) -> Bool)
-> (Workspace WorkspaceTag (Layout Window) Window
    -> Maybe (Stack Window))
-> Workspace WorkspaceTag (Layout Window) Window
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceTag (Layout Window) Window
-> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack) Maybe (Workspace WorkspaceTag (Layout Window) Window)
mws

addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a])
-> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
addHiddenWorkspace' Workspace i l a -> [Workspace i l a] -> [Workspace i l a]
add i
newtag l
l s :: StackSet i l a sid sd
s@StackSet{ hidden :: forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
hidden = [Workspace i l a]
ws } = StackSet i l a sid sd
s { hidden :: [Workspace i l a]
hidden = Workspace i l a -> [Workspace i l a] -> [Workspace i l a]
add (i -> l -> Maybe (Stack a) -> Workspace i l a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace i
newtag l
l Maybe (Stack a)
forall a. Maybe a
Nothing) [Workspace i l a]
ws }

-- | Remove the hidden workspace with the given tag from the StackSet, if
--   it exists. All the windows in that workspace are moved to the current
--   workspace.
removeWorkspace' :: (Eq i, Eq a) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
removeWorkspace' :: i -> StackSet i l a sid sd -> StackSet i l a sid sd
removeWorkspace' i
torem s :: StackSet i l a sid sd
s@StackSet{ current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current = scr :: Screen i l a sid sd
scr@Screen { workspace :: forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace = Workspace i l a
wc }
                                 , hidden :: forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
hidden  = [Workspace i l a]
hs }
    = let ([Workspace i l a]
xs, [Workspace i l a]
ys) = (Workspace i l a -> Bool)
-> [Workspace i l a] -> ([Workspace i l a], [Workspace i l a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
torem) (i -> Bool) -> (Workspace i l a -> i) -> Workspace i l a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag) [Workspace i l a]
hs
      in [Workspace i l a] -> [Workspace i l a] -> StackSet i l a sid sd
removeWorkspace'' [Workspace i l a]
xs [Workspace i l a]
ys
   where meld :: Maybe (Stack a) -> Maybe (Stack a) -> Maybe (Stack a)
meld Maybe (Stack a)
Nothing Maybe (Stack a)
Nothing = Maybe (Stack a)
forall a. Maybe a
Nothing
         meld Maybe (Stack a)
x Maybe (Stack a)
Nothing = Maybe (Stack a)
x
         meld Maybe (Stack a)
Nothing Maybe (Stack a)
x = Maybe (Stack a)
x
         meld (Just Stack a
x) (Just Stack a
y) = [a] -> Maybe (Stack a)
forall a. [a] -> Maybe (Stack a)
differentiate ([a] -> Maybe (Stack a)) -> ([a] -> [a]) -> [a] -> Maybe (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> Maybe (Stack a)) -> [a] -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ Stack a -> [a]
forall a. Stack a -> [a]
integrate Stack a
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Stack a -> [a]
forall a. Stack a -> [a]
integrate Stack a
y
         removeWorkspace'' :: [Workspace i l a] -> [Workspace i l a] -> StackSet i l a sid sd
removeWorkspace'' [Workspace i l a]
xs (Workspace i l a
y:[Workspace i l a]
ys) = StackSet i l a sid sd
s { current :: Screen i l a sid sd
current = Screen i l a sid sd
scr { workspace :: Workspace i l a
workspace = Workspace i l a
wc { stack :: Maybe (Stack a)
stack = Maybe (Stack a) -> Maybe (Stack a) -> Maybe (Stack a)
forall a.
Eq a =>
Maybe (Stack a) -> Maybe (Stack a) -> Maybe (Stack a)
meld (Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace i l a
y) (Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace i l a
wc) } }
                                         , hidden :: [Workspace i l a]
hidden = [Workspace i l a]
xs [Workspace i l a] -> [Workspace i l a] -> [Workspace i l a]
forall a. [a] -> [a] -> [a]
++ [Workspace i l a]
ys }
         removeWorkspace'' [Workspace i l a]
_  [Workspace i l a]
_      = StackSet i l a sid sd
s