module XMonad.Actions.DynamicWorkspaces (
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, mkComplFunFromList', mkXPrompt )
import XMonad.Util.WorkspaceCompare ( getSortByIndex )
import qualified Data.Map.Strict as Map
import qualified XMonad.Util.ExtensibleState as XS
type WorkspaceTag = String
type WorkspaceIndex = Int
newtype DynamicWorkspaceState = DynamicWorkspaceState {DynamicWorkspaceState -> Map WorkspaceIndex String
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 -> String
(WorkspaceIndex -> DynamicWorkspaceState -> ShowS)
-> (DynamicWorkspaceState -> String)
-> ([DynamicWorkspaceState] -> ShowS)
-> Show DynamicWorkspaceState
forall a.
(WorkspaceIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DynamicWorkspaceState] -> ShowS
$cshowList :: [DynamicWorkspaceState] -> ShowS
show :: DynamicWorkspaceState -> String
$cshow :: DynamicWorkspaceState -> String
showsPrec :: WorkspaceIndex -> DynamicWorkspaceState -> ShowS
$cshowsPrec :: WorkspaceIndex -> DynamicWorkspaceState -> ShowS
Show)
instance ExtensionClass DynamicWorkspaceState where
initialValue :: DynamicWorkspaceState
initialValue = Map WorkspaceIndex String -> DynamicWorkspaceState
DynamicWorkspaceState Map WorkspaceIndex String
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
setWorkspaceIndex :: WorkspaceIndex -> X ()
setWorkspaceIndex :: WorkspaceIndex -> X ()
setWorkspaceIndex WorkspaceIndex
widx = do
String
wtag <- (XState -> String) -> X String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String)
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
Map WorkspaceIndex String
wmap <- (DynamicWorkspaceState -> Map WorkspaceIndex String)
-> X (Map WorkspaceIndex String)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets DynamicWorkspaceState -> Map WorkspaceIndex String
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 String
workspaceIndexMap = WorkspaceIndex
-> String -> Map WorkspaceIndex String -> Map WorkspaceIndex String
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert WorkspaceIndex
widx String
wtag Map WorkspaceIndex String
wmap}
withWorkspaceIndex :: (String -> WindowSet -> WindowSet) -> WorkspaceIndex -> X ()
withWorkspaceIndex :: (String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceIndex -> X ()
withWorkspaceIndex String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
job WorkspaceIndex
widx = do
Maybe String
wtag <- WorkspaceIndex -> X (Maybe String)
ilookup WorkspaceIndex
widx
X () -> (String -> X ()) -> Maybe String -> 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
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ())
-> (String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> String
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
job) Maybe String
wtag
where
ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
ilookup :: WorkspaceIndex -> X (Maybe String)
ilookup WorkspaceIndex
idx = WorkspaceIndex -> Map WorkspaceIndex String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceIndex
idx (Map WorkspaceIndex String -> Maybe String)
-> X (Map WorkspaceIndex String) -> X (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DynamicWorkspaceState -> Map WorkspaceIndex String)
-> X (Map WorkspaceIndex String)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets DynamicWorkspaceState -> Map WorkspaceIndex String
workspaceIndexMap
withWorkspace :: XPConfig -> (String -> X ()) -> X ()
withWorkspace :: XPConfig -> (String -> X ()) -> X ()
withWorkspace XPConfig
c String -> X ()
job = do [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 (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window])
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
WorkspaceSort
sort <- X WorkspaceSort
getSortByIndex
let ts :: [String]
ts = (Workspace String (Layout Window) Window -> String)
-> [Workspace String (Layout Window) Window] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
tag ([Workspace String (Layout Window) Window] -> [String])
-> [Workspace String (Layout Window) Window] -> [String]
forall a b. (a -> b) -> a -> b
$ WorkspaceSort
sort [Workspace String (Layout Window) Window]
ws
job' :: String -> X ()
job' String
t | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ts = String -> X ()
job String
t
| Bool
otherwise = String -> X ()
addHiddenWorkspace String
t X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> X ()
job String
t
Wor -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt (String -> Wor
Wor String
"") XPConfig
c (XPConfig -> [String] -> ComplFunction
mkComplFunFromList' XPConfig
c [String]
ts) String -> X ()
job'
renameWorkspace :: XPConfig -> X ()
renameWorkspace :: XPConfig -> X ()
renameWorkspace XPConfig
conf = XPConfig -> (String -> X ()) -> X ()
workspacePrompt XPConfig
conf String -> X ()
renameWorkspaceByName
renameWorkspaceByName :: String -> X ()
renameWorkspaceByName :: String -> X ()
renameWorkspaceByName String
w = do String
old <- (XState -> String) -> X String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String)
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
(StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ())
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ \StackSet String (Layout Window) Window ScreenId ScreenDetail
s -> let sett :: Workspace i l a -> Workspace String l a
sett Workspace i l a
wk = Workspace i l a
wk { tag :: String
tag = String
w }
setscr :: Screen i l a sid sd -> Screen String l a sid sd
setscr Screen i l a sid sd
scr = Screen i l a sid sd
scr { workspace :: Workspace String l a
workspace = Workspace i l a -> Workspace String l a
forall {i} {l} {a}. Workspace i l a -> Workspace String l a
sett (Workspace i l a -> Workspace String l a)
-> Workspace i l a -> Workspace String 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 String l a sid sd -> StackSet String l a sid sd
sets StackSet String l a sid sd
q = StackSet String l a sid sd
q { current :: Screen String l a sid sd
current = Screen String l a sid sd -> Screen String l a sid sd
forall {i} {l} {a} {sid} {sd}.
Screen i l a sid sd -> Screen String l a sid sd
setscr (Screen String l a sid sd -> Screen String l a sid sd)
-> Screen String l a sid sd -> Screen String l a sid sd
forall a b. (a -> b) -> a -> b
$ StackSet String l a sid sd -> Screen String l a sid sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet String l a sid sd
q }
in StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall {l} {a} {sid} {sd}.
StackSet String l a sid sd -> StackSet String l a sid sd
sets (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (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' String
w StackSet String (Layout Window) Window ScreenId ScreenDetail
s
String -> String -> X ()
forall {m :: * -> *}. XLike m => String -> String -> m ()
updateIndexMap String
old String
w
where updateIndexMap :: String -> String -> m ()
updateIndexMap String
oldIM String
newIM = do
Map WorkspaceIndex String
wmap <- (DynamicWorkspaceState -> Map WorkspaceIndex String)
-> m (Map WorkspaceIndex String)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets DynamicWorkspaceState -> Map WorkspaceIndex String
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 String
workspaceIndexMap = ShowS -> Map WorkspaceIndex String -> Map WorkspaceIndex String
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\String
t -> if String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
oldIM then String
newIM else String
t) Map WorkspaceIndex String
wmap}
toNthWorkspace :: (String -> X ()) -> Int -> X ()
toNthWorkspace :: (String -> X ()) -> WorkspaceIndex -> X ()
toNthWorkspace String -> X ()
job WorkspaceIndex
wnum = do WorkspaceSort
sort <- X WorkspaceSort
getSortByIndex
[String]
ws <- (XState -> [String]) -> X [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Workspace String (Layout Window) Window -> String)
-> [Workspace String (Layout Window) Window] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
tag ([Workspace String (Layout Window) Window] -> [String])
-> (XState -> [Workspace String (Layout Window) Window])
-> XState
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceSort
sort WorkspaceSort
-> (XState -> [Workspace String (Layout Window) Window])
-> XState
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window])
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
case WorkspaceIndex -> [String] -> [String]
forall a. WorkspaceIndex -> [a] -> [a]
drop WorkspaceIndex
wnum [String]
ws of
(String
w:[String]
_) -> String -> X ()
job String
w
[] -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace :: (String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceIndex -> X ()
withNthWorkspace String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
job WorkspaceIndex
wnum = do WorkspaceSort
sort <- X WorkspaceSort
getSortByIndex
[String]
ws <- (XState -> [String]) -> X [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Workspace String (Layout Window) Window -> String)
-> [Workspace String (Layout Window) Window] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
tag ([Workspace String (Layout Window) Window] -> [String])
-> (XState -> [Workspace String (Layout Window) Window])
-> XState
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceSort
sort WorkspaceSort
-> (XState -> [Workspace String (Layout Window) Window])
-> XState
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window])
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
case WorkspaceIndex -> [String] -> [String]
forall a. WorkspaceIndex -> [a] -> [a]
drop WorkspaceIndex
wnum [String]
ws of
(String
w:[String]
_) -> (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ())
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
job String
w
[] -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
selectWorkspace :: XPConfig -> X ()
selectWorkspace :: XPConfig -> X ()
selectWorkspace XPConfig
conf = XPConfig -> (String -> X ()) -> X ()
workspacePrompt XPConfig
conf ((String -> X ()) -> X ()) -> (String -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \String
w ->
do StackSet String (Layout Window) Window ScreenId ScreenDetail
s <- (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
if String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall i l a s sd. Eq i => i -> StackSet i l a s sd -> Bool
tagMember String
w StackSet String (Layout Window) Window ScreenId ScreenDetail
s
then (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ())
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (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 String
w
else String -> X ()
addWorkspace String
w
addWorkspace :: String -> X ()
addWorkspace :: String -> X ()
addWorkspace = (Workspace String (Layout Window) Window -> WorkspaceSort)
-> String -> X ()
addWorkspaceAt (:)
appendWorkspace :: String -> X()
appendWorkspace :: String -> X ()
appendWorkspace = (Workspace String (Layout Window) Window -> WorkspaceSort)
-> String -> X ()
addWorkspaceAt (([Workspace String (Layout Window) Window] -> WorkspaceSort)
-> [Workspace String (Layout Window) Window] -> WorkspaceSort
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Workspace String (Layout Window) Window] -> WorkspaceSort
forall a. [a] -> [a] -> [a]
(++) ([Workspace String (Layout Window) Window] -> WorkspaceSort)
-> (Workspace String (Layout Window) Window
-> [Workspace String (Layout Window) Window])
-> Workspace String (Layout Window) Window
-> WorkspaceSort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window
-> [Workspace String (Layout Window) Window]
forall (m :: * -> *) a. Monad m => a -> m a
return)
addWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X ()
addWorkspaceAt :: (Workspace String (Layout Window) Window -> WorkspaceSort)
-> String -> X ()
addWorkspaceAt Workspace String (Layout Window) Window -> WorkspaceSort
add String
newtag = (Workspace String (Layout Window) Window -> WorkspaceSort)
-> String -> X ()
addHiddenWorkspaceAt Workspace String (Layout Window) Window -> WorkspaceSort
add String
newtag X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows (String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (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 String
newtag)
addWorkspacePrompt :: XPConfig -> X ()
addWorkspacePrompt :: XPConfig -> X ()
addWorkspacePrompt XPConfig
conf = Wor -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt (String -> Wor
Wor String
"New workspace name: ") XPConfig
conf (IO [String] -> ComplFunction
forall a b. a -> b -> a
const ([String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [])) String -> X ()
addWorkspace
appendWorkspacePrompt :: XPConfig -> X ()
appendWorkspacePrompt :: XPConfig -> X ()
appendWorkspacePrompt XPConfig
conf = Wor -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt (String -> Wor
Wor String
"New workspace name: ") XPConfig
conf (IO [String] -> ComplFunction
forall a b. a -> b -> a
const ([String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [])) String -> X ()
appendWorkspace
addHiddenWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X ()
addHiddenWorkspaceAt :: (Workspace String (Layout Window) Window -> WorkspaceSort)
-> String -> X ()
addHiddenWorkspaceAt Workspace String (Layout Window) Window -> WorkspaceSort
add String
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
. String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall i l a s sd. Eq i => i -> StackSet i l a s sd -> Bool
tagMember String
newtag (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Bool)
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (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 String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((Workspace String (Layout Window) Window -> WorkspaceSort)
-> String
-> Layout Window
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (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 String (Layout Window) Window -> WorkspaceSort
add String
newtag Layout Window
l)
addHiddenWorkspace :: String -> X ()
addHiddenWorkspace :: String -> X ()
addHiddenWorkspace = (Workspace String (Layout Window) Window -> WorkspaceSort)
-> String -> X ()
addHiddenWorkspaceAt (:)
removeEmptyWorkspace :: X ()
removeEmptyWorkspace :: X ()
removeEmptyWorkspace = (XState -> String) -> X String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String)
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset) X String -> (String -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> X ()
removeEmptyWorkspaceByTag
removeWorkspace :: X ()
removeWorkspace :: X ()
removeWorkspace = (XState -> String) -> X String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String)
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset) X String -> (String -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> X ()
removeWorkspaceByTag
removeEmptyWorkspaceByTag :: String -> X ()
removeEmptyWorkspaceByTag :: String -> X ()
removeEmptyWorkspaceByTag String
t = X Bool -> X () -> X ()
whenX (String -> X Bool
isEmpty String
t) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ String -> X ()
removeWorkspaceByTag String
t
removeWorkspaceByTag :: String -> X ()
removeWorkspaceByTag :: String -> X ()
removeWorkspaceByTag String
torem = do
StackSet String (Layout Window) Window ScreenId ScreenDetail
s <- (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
case StackSet String (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 String (Layout Window) Window
cur }, hidden :: forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
hidden = (Workspace String (Layout Window) Window
w:[Workspace String (Layout Window) Window]
_) } -> do
Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
toremString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
tag Workspace String (Layout Window) Window
cur) (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 ((StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ())
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (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 (String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
tag Workspace String (Layout Window) Window
w
(StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ())
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (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' String
torem
StackSet String (Layout Window) Window ScreenId ScreenDetail
_ -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
removeEmptyWorkspaceAfter :: X () -> X ()
removeEmptyWorkspaceAfter :: X () -> X ()
removeEmptyWorkspaceAfter = [String] -> X () -> X ()
removeEmptyWorkspaceAfterExcept []
removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X ()
removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X ()
removeEmptyWorkspaceAfterExcept [String]
sticky X ()
f = do
String
before <- (XState -> String) -> X String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String)
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
X ()
f
String
after <- (XState -> String) -> X String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String
forall i l a s sd. StackSet i l a s sd -> i
currentTag (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> String)
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
beforeString -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
after Bool -> Bool -> Bool
&& String
before String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
sticky) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ String -> X ()
removeEmptyWorkspaceByTag String
before
isEmpty :: String -> X Bool
isEmpty :: String -> X Bool
isEmpty String
t = do [Workspace String (Layout Window) Window]
wsl <- (XState -> [Workspace String (Layout Window) Window])
-> X [Workspace String (Layout Window) Window]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [Workspace String (Layout Window) Window])
-> X [Workspace String (Layout Window) Window])
-> (XState -> [Workspace String (Layout Window) Window])
-> X [Workspace String (Layout Window) Window]
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window])
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
let mws :: Maybe (Workspace String (Layout Window) Window)
mws = (Workspace String (Layout Window) Window -> Bool)
-> [Workspace String (Layout Window) Window]
-> Maybe (Workspace String (Layout Window) Window)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Workspace String (Layout Window) Window
ws -> Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
tag Workspace String (Layout Window) Window
ws String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
t) [Workspace String (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 String (Layout Window) Window -> Bool)
-> Maybe (Workspace String (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 String (Layout Window) Window
-> Maybe (Stack Window))
-> Workspace String (Layout Window) Window
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack) Maybe (Workspace String (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' :: 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 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 }
removeWorkspace' :: (Eq i, Eq a) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
removeWorkspace' :: forall i a l sid sd.
(Eq i, Eq a) =>
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